Sub Main
With Application

Dim Svno as String
Dim Sreport as String
Dim Sopdate as String
Dim Stci as String
Dim Sletter as String
Dim Sprinter as String
Dim Edit as Variant

Dim Vepisode as Variant
Dim Vmedrec as Variant
Dim Vprescreen as Variant
Dim Vonlist as Variant
Dim Vmoreonlist as Variant
Dim Vmanylist as Variant
Dim Vreenter as Variant
Dim Venter as Variant
Dim Vdata as Variant

Dim Padmdate1 as Variant
Dim Padmdate2 as Variant
Dim Padmdate3 as Variant
Dim Padmdate4 as Variant
Dim Padmtime as Variant
Dim Pdsutime as Variant

Dim Loop1 as Variant
Dim Loop2 as Variant
Dim Loop3 as Variant
Dim Loop4 as Variant
Dim Loop5 as Variant
Dim Loop6 as Variant
Dim Loop7 as Variant
Dim Loop8 as Variant
Dim Loop9 as Variant

Dim Esurname1 as Variant
Dim Esurname2 as Variant
Dim Esurname3 as Variant
Dim Esurname4 as Variant
Dim Ediaggroup1 as Variant
Dim Ediaggroup2 as Variant
Dim Ediaggroup3 as Variant
Dim Ediaggroup4 as Variant
Dim Econs1 as Variant
Dim Econs2 as Variant
Dim Econs3 as Variant
Dim Econs4 as Variant
Dim Eadmrea1 as Variant
Dim Eadmrea2 as Variant
Dim Eadmrea3 as Variant
Dim Eadmrea4 as Variant
Dim Eopdesc1 as Variant
Dim Eopdesc2 as Variant
Dim Eopdesc3 as Variant
Dim Eopdesc4 as Variant
Dim Ettime1 as Variant
Dim Ettime2 as Variant
Dim Ettime3 as Variant
Dim Ettime4 as Variant
Dim Eward1 as Variant
Dim Eward2 as Variant
Dim Eward3 as Variant
Dim Eward4 as Variant
Dim Elos1 as Variant
Dim Elos2 as Variant
Dim Elos3 as Variant
Dim Elos4 as Variant

Dim Check0 as Variant
Dim Check1 as Variant
Dim Check2 as Variant
Dim Check3 as Variant
Dim Check4 as Variant
Dim Check5 as Variant
Dim Check6 as Variant
Dim Check7 as Variant
Dim Check8 as Variant
Dim Check9 as Variant

'Defines dialog box

	Begin Dialog PreData 207, 156 
		Caption "PreAdmission"
		CheckBox 96, 5, 91, 11, "Edit current admission", .Sedit
		TextBox  91, 20, 91, 14, .Svno
		DropComboBox 91, 40, 91, 85, "DSU"+Chr$(9)+"ADM"+Chr$(9)+"PEA"+Chr$(9)+"RT"+Chr$(9)+"MD"+Chr$(9)+"BR"+Chr$(9)+"UCK", .Sreport
		TextBox  91, 59, 91, 14, .Sopdate
		TextBox  91, 79, 53, 14, .Stci
		TextBox  149, 79, 32, 14, .Stcitime
		DropComboBox 91, 99, 91, 94, "ADM"+Chr$(9)+"DCA"+Chr$(9)+"DOA"+Chr$(9)+"LA"+Chr$(9)+"DSU"+Chr$(9)+"PDA"+Chr$(9)+"PG3"+Chr$(9)+"PIA"+Chr$(9)+"CSI"+Chr$(9)+"WEEKEND"+Chr$(9)+"CPPREDONE"+Chr$(9)+"CPTELPRE"+Chr$(9)+"CPFULLPRE", .Sletter
		CheckBox 96, 118, 91, 11, "Patient Information Form", .Spform
		OKButton 48, 133, 45, 14, .okButton
		CancelButton 101, 133, 45, 14, .cancelButton
		Text 5, 25, 64, 11, "Hospital Number", .label1
		Text 5, 45, 41, 11, "Report To", .label2
		Text 5, 64, 75, 11, "Operation Date", .label3
		Text 5, 84, 79, 11, "Admission Date + Time", .label4
		Text 5, 104, 30, 11, "Letter", .label5
	End Dialog


On Error GoTo 0

Dim Data as PreData

' Checks screen

Vprescreen = .Findtext("P r e a d m i s s i o n",0,0)
If Vprescreen = False Then
 Exit Sub
End If

' Shows dialog box

Vdata = Dialog(Data)

' Exits if you press "cancel"

If Vdata = 0 Then
  Exit Sub
End If

' Checks entered data for errors

Let Check0 = True

' Op date format

Check2 = IsDate(Data.Sopdate)
If Check2 = False Then
 Sopdate = Format$(Data.Sopdate, "@@/@@/@@")
  If IsDate(Sopdate) Then 
   Let Data.Sopdate = Sopdate
  Else 
   Let Check0 = False
  End If
End If

' TCI date format

Check3 = IsDate(Data.Stci)
If Check3 = False Then
 Stci = Format$(Data.Stci, "@@/@@/@@")
  If IsDate(Stci) Then 
   Let Data.Stci = Stci
  Else 
   Let Check0 = False
  End If
End If

'TCI time format - not working currently

' If Not InStr(Data.Stcitime, ":") Then
'  If Len(Data.Stcitime) = 4 Then
'  Data.Stcitime = Format$(Data.Stcitime,"@@:@@")
' Else
'  Check0 = False
' End If
'End If

Let Data.Stci = Data.Stci + " " + Data.Stcitime

If Data.Sedit = 0 Then
 If Check0 = False Then
   Print "Incorrect / Missing Data"
   Exit Sub
 End If
End If



' Enters V number

.Transmit Data.Svno & Chr$(rcCR)

' Echo surname

.Wait "1"
Esurname1 = .FindText("Surname",0,0)
If Esurname1 = False Then
  Esurname4 = "Not Found"
End If
Esurname2 = .FoundTextRow
Esurname3 = .FoundTextColumn
Esurname4 = Trim(.GetText(Esurname2, Esurname3+11, Esurname2, Esurname3+25))

.Transmit "N" & Chr$(rcCR)
.Wait "1"

' Picks episode

If Data.Sedit = 0 Then
 Let Edit = "WL ACTV"
Else
 Let Edit = "PREADM TCI"
End If

Do
Vonlist = .FindText(Edit,0,0)
Vmoreonlist = .FindText("<More available>",0,0)
Vmanylist= .FindText("2  " + Edit,0,0)

If Vonlist = False Then
 If Vmoreonlist = True Then
  .Transmit Chr$(rcCR)
 Else
  Print "This patient is not on the waiting list"
  Exit Sub
 End If
Else
 If Vmanylist = False Then
  If Vmoreonlist = False Then
   .Transmit "1" & Chr$(rcCR)
  Else
   Let Vepisode = InputBox("Pick episode number, or type N for next screen", "Choose Episode") 
   If Vepisode = "N" Then 
    .Transmit Chr$(rcCR)
   ElseIf Vepisode = "n" Then
    .Transmit Chr$(rcCR)
   Else
    .Transmit Vepisode + Chr$(rcCR)
   End If
  End If
 Else
  Let Vepisode = InputBox("Pick episode number, or type N for next screen", "Choose Episode") 
   If Vepisode = "N" Then 
    .Transmit Chr$(rcCR)
   ElseIf Vepisode = "n" Then
    .Transmit Chr$(rcCR)
   Else
    .Transmit Vepisode + Chr$(rcCR)
   End If
 End If
End If
.Wait "1"

If Data.Sedit = 1 Then
Vmedrec = .Findtext("Command", 0, 0)
Else
Vmedrec = .Findtext("Med Rec No", 0, 0)
End If

Loop Until Vmedrec = True

If Data.Sedit = 1 Then
 .Transmit "REVISE" & Chr$(rcCR)
End If

'Enters through screens, inputs data

.Transmit Chr$(rcCR)
For Loop1 = 1 to 5
 .Transmit "N" & Chr$(rcCR)
Next Loop1

' Echo inpatient/daycase and consultant

.Wait "1"
Ediaggroup1 = .FindText("Diag Group",0,0)
If Ediaggroup1 = False Then
  Ediaggroup4 = "Not Found"
End If
Ediaggroup2 = .FoundTextRow
Ediaggroup3 = .FoundTextColumn
Ediaggroup4 = Trim(.GetText(Ediaggroup2, Ediaggroup3+15, Ediaggroup2, Ediaggroup3+20))
Econs1 = .FindText("Consultant",0,0)
If Econs1 = False Then
  Econs4 = "Not Found"
End If
Econs2 = .FoundTextRow
Econs3 = .FoundTextColumn
Econs4 = Trim(.GetText(Econs2, Econs3+24, Econs2, Econs3+50))

For Loop2 = 1 to 14
 .Transmit Chr$(rcCR)
Next Loop2

' Report to Location

.Transmit Data.Sreport & Chr$(rcCR)
For Loop3 = 1 to 5
 .Transmit Chr$(rcCR)
Next Loop3

' Echo op description and theatre time

.Wait "1"
Eadmrea1 = .FindText("Adm Reason",0,0)
If Eadmrea1 = False Then
  Eadmrea4 = "Not Found"
End If
Eadmrea2 = .FoundTextRow
Eadmrea3 = .FoundTextColumn
Eadmrea4 = Trim(.GetText(Eadmrea2, Eadmrea3+13, Eadmrea2, Eadmrea3+50))
Eopdesc1 = .FindText("Operation",0,0)
If Eopdesc1 = False Then
  Eopdesc4 = "Not Found"
End If
Eopdesc2 = .FoundTextRow
Eopdesc3 = .FoundTextColumn
Eopdesc4 = Trim(.GetText(Eopdesc2, Eopdesc3+13, Eopdesc2, Eopdesc3+50))
Ettime1 = .FindText("Theatre time",0,0)
If Ettime1 = False Then
  Ettime4 = "Not Found"
End If
Ettime2 = .FoundTextRow
Ettime3 = .FoundTextColumn
Ettime4 = Trim(.GetText(Ettime2, Ettime3+14, Ettime2, Ettime3+20))

'Operation Date

.Transmit "Y" & Chr$(rcCR)
.Transmit Data.Sopdate & Chr$(rcCR) & Chr$(rcCR) & Chr$(rcCR)

' Echo ward and length of stay

.Wait "1"
Eward1 = .FindText("Expected Ward",0,0)
If Eward1 = False Then
  Eward4 = "Not Found"
End If
Eward2 = .FoundTextRow
Eward3 = .FoundTextColumn
Eward4 = Trim(.GetText(Eward2, Eward3+24, Eward2, Eward3+50))
Elos1 = .FindText("Expected LOS",0,0)
If Elos1 = False Then
  Elos4 = "Not Found"
End If
Elos2 = .FoundTextRow
Elos3 = .FoundTextColumn
Elos4 = Trim(.GetText(Elos2, Elos3+14, Elos2, Elos3+20))

' Enters TCI twice if necessary

.Transmit Data.Stci & Chr$(rcCR)
.Wait "2"
Vreenter = .FindText("Reenter to confirm",0,0)
 If Vreenter = True Then
  .Transmit Data.Stci & Chr$(rcCR)
 End If
For Loop4 = 1 to 5
 .Transmit Chr$(rcCR)
Next Loop4

.Wait "1"

Padmdate1 = .FindText("Exp Adm Date/Time :",0,0)
If Padmdate1 = False Then
  Padmdate4 = " "
  Padmtime = " "
End If
Padmdate2 = .FoundTextRow
Padmdate3 = .FoundTextColumn
Padmdate4 = Trim(.GetText(Padmdate2, Padmdate3+19, Padmdate2, Padmdate3+29))
Padmtime = Trim(.GetText(Padmdate2, Padmdate3+30, Padmdate2, Padmdate3+35))

'Enters until "Enter?" field

Do 
 .Transmit Chr$(rcCR)
 .Wait "1"
 Venter = .FindText("ERROR: Field is required",0,0)
Loop Until Venter = True 

Check1 = MsgBox("Surname:	" + Esurname4 + Chr$(rcCR) + "Patient type:	" + Ediaggroup4 + Chr$(rcCR) + "Consultant:	" + Econs4 + Chr$(rcCR) + "Operation:	" + Eopdesc4 + Chr$(rcCR) + "Other details:	"+ Eadmrea4 + Chr$(rcCR) + "Theatre time:	" + Ettime4 + " minutes" + Chr$(rcCR) + "Ward:		" + Eward4 + Chr$(rcCR) + "Length of Stay:	" + Elos4 + " nights",1,"Please check this information is correct")

If Check1 = 2 Then
 Exit Sub
End If

 .Transmit "Y" & Chr$(rcCR)
 .Transmit "N" & Chr$(rcCR)

' Prints letter

If Data.Sletter = "CPFULLPRE" Then
   Sprinter = "QSADM"
ElseIf Data.Sletter = "cpfullpre" Then
   Sprinter = "QSADM"
Else
   Sprinter = "ADM1H"
End If

.Transmit Data.Sletter & Chr$(rcCR)
.Transmit Sprinter & Chr$(rcCR)
.Transmit "1" & Chr$(rcCR) & "Y" & Chr$(rcCR) & Chr$(rcCR)
If Sprinter = "QSADM" Then
 Print "To print this letter, use the ZPV function"
End If



End With

If Data.Spform = 1 Then

If Data.Sreport = "DSU" Then
 Pdsutime = MsgBox("Print admission time on form?",4)
 If Pdsutime = "7" Then
  Let Padmtime = "TBA"
 End If
ElseIf Data.Sreport = "dsu" Then
 Pdsutime = MsgBox("Print admission time on form?",4)
 If Pdsutime = "7" Then
  Let Padmtime = "TBA"
 End If
End If

If Data.Sreport = "ADM" Then
 Let Eward4 = " "
ElseIf Data.Sreport = "adm" Then
 Let Eward4 = " "
End If

'Prints Patient Information Form

	Dim word As Object
	Set word = CreateObject("Word.Application")

With word
 
 .ChangeFileOpenDirectory "J:\Admissions Shared Folder\"
    .Documents.Open FileName:="""Patient Information Form.doc""" 
    
    
    .Selection.Find.ClearFormatting
    With .Selection.Find
        .Text = "the hospital"
        .Replacement.Text = ""
        .Forward = True
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    .Selection.Find.Execute
    .Selection.MoveRight Count:=23
    .Selection.TypeText Text:= " " + Padmdate4
    .Selection.MoveRight Count:=14
    .Selection.TypeText Text:= " " + Data.Svno
    .Selection.MoveRight Count:=13
    .Selection.TypeText Text:= " " + Econs4
    .Selection.MoveRight Count:=9
    .Selection.TypeText Text:= Padmtime
    .Selection.MoveRight Count:=8
    .Selection.TypeText Text:= Eward4
    .Application.PrintOut
    .ActiveDocument.Close SaveChanges:= rcChangesNever

End With
End If
End Sub