| 1 | TMGRPC3F ;TMG/kst/Support Functions for GUI_Config ;08/31/08
 | 
|---|
| 2 |          ;;1.02;TMG-LIB;**1**;11/18/08
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ;"TMG RPC FUNCTIONS for a GUI config program
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 |  ;"Kevin Toppenberg MD
 | 
|---|
| 7 |  ;"GNU Lessor General Public License (LGPL) applies
 | 
|---|
| 8 |  ;"7/20/08
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 |  ;"=======================================================================
 | 
|---|
| 11 |  ;" RPC -- Public Functions.
 | 
|---|
| 12 |  ;"=======================================================================
 | 
|---|
| 13 |  ;" <none>
 | 
|---|
| 14 |  ;"=======================================================================
 | 
|---|
| 15 |  ;"PRIVATE API FUNCTIONS
 | 
|---|
| 16 |  ;"=======================================================================
 | 
|---|
| 17 |  ;"REGPAT(TMGOUT,TMGPARAMS) -- register a new patient into VistA, providing not already been registered.
 | 
|---|
| 18 |  ;"SRCHPTEXACT(TMGARRAY) -- search for a preexisting patient, using an exact search
 | 
|---|
| 19 |  ;
 | 
|---|
| 20 |  ;"=======================================================================
 | 
|---|
| 21 |  ;"Dependencies:
 | 
|---|
| 22 |  ;"  TMGRPC3* only
 | 
|---|
| 23 |  ;
 | 
|---|
| 24 |  ;"=======================================================================
 | 
|---|
| 25 |  ;
 | 
|---|
| 26 | REGPAT(TMGOUT,TMGPARAMS) ;"REGISTER PATIENT
 | 
|---|
| 27 |         ;"Purpose: to register a new patient into VistA, providing that they have not
 | 
|---|
| 28 |         ;"         already been registered.
 | 
|---|
| 29 |         ;"Note: The search for preexisting records is exact, meaning that DOE,JOHN
 | 
|---|
| 30 |         ;"      would be considered different from DOE,JOHN H
 | 
|---|
| 31 |         ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
 | 
|---|
| 32 |         ;"       TMGPARAMS -- FieldNum1^FieldValue1^FieldNum2^FieldValue2^FieldNum3^FieldValue3^...
 | 
|---|
| 33 |         ;"       NOTE: Because I want to be able to specify here the HealthRecordNumber (HRN),
 | 
|---|
| 34 |         ;"             even though it is not truly a field in the PATIENT file, I am going
 | 
|---|
| 35 |         ;"             to manually allow a field of '0' (HRN) to be specified as a FieldNumber
 | 
|---|
| 36 |         ;"Output: TMGOUT is filled as follows:
 | 
|---|
| 37 |         ;"          TMGOUT(0)="1^Success^NewIEN" or
 | 
|---|
| 38 |         ;"                    "0^BoolAndMessage^NewIEN".  Format:
 | 
|---|
| 39 |         ;"                       [Bool1;Bool2;Bool3;Bool4;Bool5*MessageText]  (e.g. '1;0;1;0;0*ErrorMsg')
 | 
|---|
| 40 |         ;"                         (for Bool fields, 0=no or 1=yes)
 | 
|---|
| 41 |         ;"                         Bool1 -- patient had previously been registered
 | 
|---|
| 42 |         ;"                         Bool2 -- patient registered during this Fn
 | 
|---|
| 43 |         ;"                         Bool3 -- problem filing data into non-identifier fields
 | 
|---|
| 44 |         ;"                         Bool4 -- problem filing data into sub-file fields
 | 
|---|
| 45 |         ;"                         Bool5 -- problem with filing HRN
 | 
|---|
| 46 |         ;"                    "-1^Message"    Frank failure...
 | 
|---|
| 47 |         ;"          TMGOUT(1)=Long Fileman message (if -1 error, or perhaps 0 code)
 | 
|---|
| 48 |  ;
 | 
|---|
| 49 |         NEW TMGRSLT,TMGRCOD1,TMGRCOD2,TMGRCOD3,TMGRCOD4,TMGRCOD5,TMGRMSG
 | 
|---|
| 50 |         SET TMGRSLT=1,(TMGCOD1,TMGCOD2,TMGCOD3,TMGCOD4,TMGCOD5)=0,TMGMSG=""
 | 
|---|
| 51 |         NEW TMGARRAY
 | 
|---|
| 52 |         NEW TMGFDA,TMGMSG
 | 
|---|
| 53 |         FOR  DO  QUIT:($LENGTH(TMGPARAMS,"^"))<2
 | 
|---|
| 54 |         . NEW TMGPAIR,TMGFIELD,TMGVALUE
 | 
|---|
| 55 |         . SET TMGPAIR=$PIECE(TMGPARAMS,"^",1,2)
 | 
|---|
| 56 |         . SET TMGFIELD=$PIECE(TMGPAIR,"^",1)
 | 
|---|
| 57 |         . SET TMGVALUE=$PIECE(TMGPAIR,"^",2)
 | 
|---|
| 58 |         . SET TMGPARAMS=$EXTRACT(TMGPARAMS,$LENGTH(TMGPAIR)+2,999)
 | 
|---|
| 59 |         . IF (TMGFIELD="")!(TMGVALUE="") QUIT
 | 
|---|
| 60 |         . SET TMGARRAY(TMGFIELD)=TMGVALUE
 | 
|---|
| 61 |  ;
 | 
|---|
| 62 |         ;"Prepair list of required identifiers (needed to create record)
 | 
|---|
| 63 |         NEW TMGRECID,TMGFLD
 | 
|---|
| 64 |         SET TMGFLD=0
 | 
|---|
| 65 |         FOR  SET TMGFLD=$O(^DD(2,TMGFLD)) Q:'TMGFLD  DO
 | 
|---|
| 66 |         . NEW NODE,REQUIRED,ID
 | 
|---|
| 67 |         . SET NODE=$GET(^(TMGFLD,0))
 | 
|---|
| 68 |         . IF NODE'="" DO
 | 
|---|
| 69 |         . . SET NAME=$P(NODE,"^")
 | 
|---|
| 70 |         . . SET REQUIRED=$P(NODE,"^",2)["R"
 | 
|---|
| 71 |         . . SET ID=$DATA(^DD(2,0,"ID",TMGFLD))
 | 
|---|
| 72 |         . . IF REQUIRED&ID SET TMGRECID(TMGFLD)=1
 | 
|---|
| 73 |  ;
 | 
|---|
| 74 |         NEW TMGIEN SET TMGIEN=$$SRCHPTEXACT(.TMGARRAY)
 | 
|---|
| 75 |         IF +TMGIEN>0 DO  GOTO RP2  ;"Continue to possibly update data in other fields
 | 
|---|
| 76 |         . SET TMGRSL=0,TMGCOD1=1
 | 
|---|
| 77 |         . ;"SET TMGOUT(0)="-1^Patient already registered^"_TMGIEN
 | 
|---|
| 78 |  ;
 | 
|---|
| 79 |         ;"Load TMGFDA with elements of basic record first, then add other
 | 
|---|
| 80 |         ;"fields on subsequent post (I think I have had problems trying to
 | 
|---|
| 81 |         ;"load some fields when the record has not already been created.)
 | 
|---|
| 82 |         KILL TMGIEN
 | 
|---|
| 83 |         SET TMGFDA(2,"+1,",.01)=TMGARRAY(.01)
 | 
|---|
| 84 |         KILL TMGARRAY(.01)
 | 
|---|
| 85 |         SET TMGFLD=""
 | 
|---|
| 86 |         FOR  SET TMGFLD=$ORDER(TMGRECID(TMGFLD)) Q:TMGFLD=""  DO
 | 
|---|
| 87 |         . IF $DATA(TMGARRAY(TMGFLD))=0 QUIT  ;"Required identifier is missing, expect Filman error below
 | 
|---|
| 88 |         . NEW TMGVALUE SET TMGVALUE=$GET(TMGARRAY(TMGFLD))
 | 
|---|
| 89 |         . KILL TMGARRAY(TMGFLD)
 | 
|---|
| 90 |         . IF TMGVALUE="" QUIT
 | 
|---|
| 91 |         . SET TMGFDA(2,"+1,",TMGFLD)=TMGVALUE
 | 
|---|
| 92 |         ;"Create new record
 | 
|---|
| 93 |         DO UPDATE^DIE("SE","TMGFDA","TMGIEN","TMGMSG")
 | 
|---|
| 94 |         IF $DATA(TMGMSG("DIERR")) DO  GOTO RPTDONE
 | 
|---|
| 95 |         . SET TMGOUT(0)="-1^See Fileman message"
 | 
|---|
| 96 |         . SET TMGOUT(1)=$$GETERSTR^TMGRPC3G(.TMGMSG)
 | 
|---|
| 97 |         . DO ADDFDA^TMGRPC3G(.TMGFDA,.TMGOUT,2)
 | 
|---|
| 98 |         SET TMGCOD2=1  ;"patient registered OK
 | 
|---|
| 99 |         ;"Get IEN of new record
 | 
|---|
| 100 |         SET TMGIEN=$GET(TMGIEN(1))
 | 
|---|
| 101 |         IF TMGIEN'>0 DO  GOTO RPTDONE
 | 
|---|
| 102 |         . SET TMGRSLT=0
 | 
|---|
| 103 |         . SET TMGOUT(0)=TMGRSLT_"^"_TMGCOD1_";"_TMGCOD2_";"_TMGCOD3_";"_TMGCOD4_";"_TMGCOD5_"*Unable to find IEN of added record"
 | 
|---|
| 104 |  ;
 | 
|---|
| 105 | RP2     ;"Now add the other fields not put in on first pass.
 | 
|---|
| 106 |         NEW TMGFIELD SET TMGFIELD=""
 | 
|---|
| 107 |         KILL TMGFDA,TMGMSG,TMGMVA
 | 
|---|
| 108 |         FOR  SET TMGFIELD=$ORDER(TMGARRAY(TMGFIELD)) QUIT:(TMGFIELD="")  DO
 | 
|---|
| 109 |         . IF TMGFIELD="0" QUIT   ;" pseudoField '0' from client will hold HRN
 | 
|---|
| 110 |         . NEW TMGA
 | 
|---|
| 111 |         . DO FIELD^DID(2,TMGFIELD,,"MULTIPLE-VALUED","TMGA","TMGMSG")
 | 
|---|
| 112 |         . IF TMGA("MULTIPLE-VALUED")=1 SET TMGMVA(TMGFIELD)=1 QUIT ;"Process separately later
 | 
|---|
| 113 |         . NEW TMGVALUE SET TMGVALUE=$GET(TMGARRAY(TMGFIELD))
 | 
|---|
| 114 |         . IF TMGVALUE="" QUIT
 | 
|---|
| 115 |         . SET TMGFDA(2,TMGIEN_",",TMGFIELD)=TMGVALUE
 | 
|---|
| 116 |  ;
 | 
|---|
| 117 |         ;"File additional info in additional fields (Not multi-valued fields)
 | 
|---|
| 118 |         IF $DATA(TMGFDA) DO
 | 
|---|
| 119 |         . DO FILE^DIE("SE","TMGFDA","TMGMSG")
 | 
|---|
| 120 |         IF $DATA(TMGMSG("DIERR")) DO  ;"GOTO RPTDONE  --Keep going, try to file more...
 | 
|---|
| 121 |         . SET TMGRSLT=0,TMGCOD3=1 ;"Error adding fields
 | 
|---|
| 122 |         . SET TMGOUT(0)=TMGRSLT_"^"_TMGCOD1_";"_TMGCOD2_";"_TMGCOD3_";"_TMGCOD4_";"_TMGCOD5_"*See Fileman message^"_TMGIEN
 | 
|---|
| 123 |         . IF $GET(TMGOUT(1))'="" SET TMGOUT(1)=TMGOUT(1)_"// "
 | 
|---|
| 124 |         . SET TMGOUT(1)=$GET(TMGOUT(1))_$$GETERSTR^TMGRPC3G(.TMGMSG)
 | 
|---|
| 125 |         . DO ADDFDA^TMGRPC3G(.TMGFDA,.TMGOUT,2)
 | 
|---|
| 126 |  ;
 | 
|---|
| 127 |         ;"Now add multi-valued fields into subfiles.
 | 
|---|
| 128 |         ;"It is assumed that the value supplied will go into the .01 field in the subfile.
 | 
|---|
| 129 |         SET TMGFIELD=""
 | 
|---|
| 130 |         KILL TMGFDA,TMGMSG
 | 
|---|
| 131 |         NEW TMGABORT SET TMGABORT=0
 | 
|---|
| 132 |         FOR  SET TMGFIELD=$ORDER(TMGMVA(TMGFIELD)) QUIT:(TMGFIELD="")!TMGABORT  DO
 | 
|---|
| 133 |         . NEW TMGTEMP,TMGFN SET TMGFN=+$PIECE($GET(^DD(2,TMGFIELD,0)),"^",2)
 | 
|---|
| 134 |         . IF TMGFN'>0 QUIT
 | 
|---|
| 135 |         . NEW TMGVALUE SET TMGVALUE=$GET(TMGARRAY(TMGFIELD))
 | 
|---|
| 136 |         . IF TMGVALUE="" QUIT
 | 
|---|
| 137 |         . SET TMGFDA(TMGFN,"?+1,"_TMGIEN_",",.01)=TMGVALUE
 | 
|---|
| 138 |         . DO UPDATE^DIE("E","TMGFDA","TMGTEMP","TMGMSG")
 | 
|---|
| 139 |         . IF $DATA(TMGMSG("DIERR")) DO
 | 
|---|
| 140 |         . . SET TMGRSLT=0,TMGCOD4=1 ;"Problem adding to subfiles
 | 
|---|
| 141 |         . . SET TMGOUT(0)=TMGRSLT_"^"_TMGCOD1_";"_TMGCOD2_";"_TMGCOD3_";"_TMGCOD4_";"_TMGCOD5_"*See Fileman message^"_TMGIEN
 | 
|---|
| 142 |         . . IF $GET(TMGOUT(1))'="" SET TMGOUT(1)=TMGOUT(1)_"// "
 | 
|---|
| 143 |         . . SET TMGOUT(1)=$GET(TMGOUT(1))_$$GETERSTR^TMGRPC3G(.TMGMSG)
 | 
|---|
| 144 |         . . DO ADDFDA^TMGRPC3G(.TMGFDA,.TMGOUT,2)
 | 
|---|
| 145 |         . . ;"SET TMGABORT=1  --keep going...
 | 
|---|
| 146 |         IF TMGABORT GOTO RPTDONE
 | 
|---|
| 147 |  ;
 | 
|---|
| 148 |         IF $GET(TMGOUT(0))="" SET TMGOUT(0)="1^Success^"_TMGIEN
 | 
|---|
| 149 |  ;
 | 
|---|
| 150 |         NEW TMGHRN SET TMGHRN=$GET(TMGARRAY("0"))=""   ;" pseudoField '0' from client will hold HRN
 | 
|---|
| 151 |         IF TMGHRN="" GOTO RPTDONE
 | 
|---|
| 152 |         ;"Set TMGHRN field in file 9000001 (^AUPNPAT), linked to Patient entry
 | 
|---|
| 153 |  ;
 | 
|---|
| 154 |         NEW TMGLOCIEN,TMGINSTIEN
 | 
|---|
| 155 |         ;"Get DEFAULT INSTITUTION from KERNEL SYSTEM PARAMETERS.
 | 
|---|
| 156 |         SET TMGINSTIEN=$PIECE($GET(^XTV(8989.3,1,"XUS")),"^",17) ;" XUS;17 = DEFAULT INSTITUTION
 | 
|---|
| 157 |         IF +TMGINSTIEN'>0 DO  GOTO RPTDONE
 | 
|---|
| 158 |         . ;"SET TMGOUT(0)="1^Success (but see message)^"_TMGIEN
 | 
|---|
| 159 |         . SET TMGOUT(0)="0^"_TMGCOD1_";"_TMGCOD2_";"_TMGCOD3_";"_TMGCOD4_";"_TMGCOD5_"*See message^"_TMGIEN
 | 
|---|
| 160 |         . SET TMGOUT(1)="Unable to add HRN because couldn't find value for DEFAULT INSTITUTION in KERNEL SYSTEM PARAMETERS file."
 | 
|---|
| 161 |  ;
 | 
|---|
| 162 |         ;"Get LOCATION file entry pointing to this INSTITUTION
 | 
|---|
| 163 |         SET TMGLOCIEN=$ORDER(^AUTTLOC("B",TMGINSTIEN,""))
 | 
|---|
| 164 |         IF +TMGLOCIEN'>0 DO  GOTO RPTDONE
 | 
|---|
| 165 |         . SET TMGOUT(0)="0^"_TMGCOD1_";"_TMGCOD2_";"_TMGCOD3_";"_TMGCOD4_";"_TMGCOD5_"*See message^"_TMGIEN
 | 
|---|
| 166 |         . ;"SET TMGOUT(0)="1^Success (but see message)^"_TMGIEN
 | 
|---|
| 167 |         . SET TMGOUT(1)="Unable to add HRN because couldn't find `"_TMGINSTIEN_" in LOCATION file"
 | 
|---|
| 168 |  ;
 | 
|---|
| 169 |         NEW TMGHRNIEN SET TMGHRNIEN=+$ORDER(^AUNPNPAT("B",TMGIEN,""))
 | 
|---|
| 170 |         IF TMGHRNIEN'>0 DO  GOTO RPTDONE
 | 
|---|
| 171 |         . SET TMGOUT(0)="0^"_TMGCOD1_";"_TMGCOD2_";"_TMGCOD3_";"_TMGCOD4_";"_TMGCOD5_"*See message^"_TMGIEN
 | 
|---|
| 172 |         . ;"SET TMGOUT(0)="1^Success (but see message)^"_TMGIEN
 | 
|---|
| 173 |         . SET TMGOUT(1)="Unable to add HRN because couldn't find record in PATIENT/IHS file"
 | 
|---|
| 174 |  ;
 | 
|---|
| 175 |         KILL TMGFDA,TMGMSG
 | 
|---|
| 176 |         ;"Now see if there already is an entry for TMGLOCIEN  (DINUM in play, so subFile record#=TMGLOCIEN)
 | 
|---|
| 177 |         IF $GET(^AUPNPAT(TMGHRNIEN,41,TMGLOCIEN,0))="" DO
 | 
|---|
| 178 |         . ;"Put HRN into value for current subfile entry
 | 
|---|
| 179 |         . SET TMGFDA(9000001.41,TMGLOCIEN_","_TMGHRNIEN_",",.02)=TMGHRN
 | 
|---|
| 180 |         . DO FILE^DIE("S","TMGFDA","TMGMSG")
 | 
|---|
| 181 |         . IF $DATA(TMGMSG("DIERR")) DO
 | 
|---|
| 182 |         . . SET TMGOUT(0)="0^"_TMGCOD1_";"_TMGCOD2_";"_TMGCOD3_";"_TMGCOD4_";"_TMGCOD5_"*See message^"_TMGIEN
 | 
|---|
| 183 |         . . ;"SET TMGOUT(0)="1^Success (but see message)^"_TMGIEN
 | 
|---|
| 184 |         . . IF $GET(TMGOUT(1))'="" SET TMGOUT(1)=TMGOUT(1)_"// "
 | 
|---|
| 185 |         . . SET TMGOUT(1)=$GET(TMGOUT(1))_$$GETERSTR^TMGRPC3G(.TMGMSG)
 | 
|---|
| 186 |         . . DO ADDFDA^TMGRPC3G(.TMGFDA,.TMGOUT,2)
 | 
|---|
| 187 |         ELSE  DO
 | 
|---|
| 188 |         . ;"Add new subfile entry for HRN
 | 
|---|
| 189 |         . NEW TMGSIEN
 | 
|---|
| 190 |         . SET TMGFDA(9000001.41,TMGLOCIEN_","_TMGHRNIEN_",",.01)=TMGLOCIEN
 | 
|---|
| 191 |         . SET TMGFDA(9000001.41,TMGLOCIEN_","_TMGHRNIEN_",",.02)=TMGHRN
 | 
|---|
| 192 |         . DO UPDATE^DIE("S","TMGFDA","TMGSIEN","TMGMSG")
 | 
|---|
| 193 |         . IF $DATA(TMGMSG("DIERR")) DO
 | 
|---|
| 194 |         . . SET TMGOUT(0)="0^"_TMGCOD1_";"_TMGCOD2_";"_TMGCOD3_";"_TMGCOD4_";"_TMGCOD5_"*See message^"_TMGIEN
 | 
|---|
| 195 |         . . ;"SET TMGOUT(0)="1^Success (but see message)^"_TMGIEN
 | 
|---|
| 196 |         . . IF $GET(TMGOUT(1))'="" SET TMGOUT(1)=TMGOUT(1)_"// "
 | 
|---|
| 197 |         . . SET TMGOUT(1)=$GET(TMGOUT(1))_$$GETERSTR^TMGRPC3G(.TMGMSG)
 | 
|---|
| 198 |         . . DO ADDFDA^TMGRPC3G(.TMGFDA,.TMGOUT,2)
 | 
|---|
| 199 |  ;
 | 
|---|
| 200 | RPTDONE ;
 | 
|---|
| 201 |         QUIT
 | 
|---|
| 202 |  ;
 | 
|---|
| 203 | SRCHPTEXACT(TMGARRAY) ;
 | 
|---|
| 204 |         ;"Purpose: to search for a preexisting patient, using an exact search
 | 
|---|
| 205 |         ;"      By exact search, I mean that DOE,JOHN would be considered different
 | 
|---|
| 206 |         ;"      from DOE,JOHN H because it is a different ascii string.  Etc.
 | 
|---|
| 207 |         ;"      However, see search description below.
 | 
|---|
| 208 |         ;"Input: TMGARRAY -- PASS BY REFERENCE. Search info.  Format:
 | 
|---|
| 209 |         ;"              TMGARRAY(.01)=PatientName, e.g. DOE,JOHN
 | 
|---|
| 210 |         ;"              TMGARRAY(.02)=Sex          e.g. M
 | 
|---|
| 211 |         ;"              TMGARRAY(.03)=DOB          e.g. 01-04-69 (an external date format)
 | 
|---|
| 212 |         ;"              TMGARRAY(.09)=SSNum        e.g. 123-45-6789
 | 
|---|
| 213 |         ;"Result: returns DFN (patient IEN), or 0^Message if not found.
 | 
|---|
| 214 |         ;"Notes:
 | 
|---|
| 215 |         ;"    The following are sufficient for search:
 | 
|---|
| 216 |         ;"    -- SSNum only
 | 
|---|
| 217 |         ;"    -- or Name-Sex-DOB
 | 
|---|
| 218 |         ;"
 | 
|---|
| 219 |         ;"    Search technique:
 | 
|---|
| 220 |         ;"    1. Search for SSN, if found then no further comparison made.
 | 
|---|
| 221 |         ;"    2. Search for exact name match, no none found, then exit with 0
 | 
|---|
| 222 |         ;"    3. ...
 | 
|---|
| 223 |  ;
 | 
|---|
| 224 |         NEW TMGRESULT SET TMGRESULT=0
 | 
|---|
| 225 |  ;
 | 
|---|
| 226 |         ;"Search by SSN.  Quit if match found
 | 
|---|
| 227 |         NEW TMGSSN SET TMGSSN=$TRANSLATE($GET(TMGARRAY(.09)),"-","")
 | 
|---|
| 228 |         IF TMGSSN'="" SET TMGRESULT=+$ORDER(^DPT("SSN",TMGSSN,""))
 | 
|---|
| 229 |         IF TMGRESULT>0 GOTO PSEDONE
 | 
|---|
| 230 |  ;
 | 
|---|
| 231 |         NEW TMGNAME,TMGSEX,TMGDOB
 | 
|---|
| 232 |         SET TMGNAME=$GET(TMGARRAY(.01))
 | 
|---|
| 233 |         IF TMGNAME="" DO  GOTO PSEDONE
 | 
|---|
| 234 |         . SET TMGRESULT="0^No Name (.01 field) provided"
 | 
|---|
| 235 |  ;
 | 
|---|
| 236 |         SET TMGSEX=$GET(TMGARRAY(.02))
 | 
|---|
| 237 |         IF TMGSEX="" DO  GOTO PSEDONE
 | 
|---|
| 238 |         . SET TMGRESULT="0^Sex (.02 field) not specified"
 | 
|---|
| 239 |         IF (TMGSEX'="M")&(TMGSEX'="F") DO  GOTO PSEDONE
 | 
|---|
| 240 |         . SET TMGRESULT="0^Sex should be 'Y' or 'N'.  Value provided="_TMGSEX
 | 
|---|
| 241 |  ;
 | 
|---|
| 242 |         SET TMGDOB=$GET(TMGARRAY(.03))
 | 
|---|
| 243 |         IF TMGDOB="" DO  GOTO PSEDONE
 | 
|---|
| 244 |         . SET TMGRESULT="0^No DOB (.03 field) provided"
 | 
|---|
| 245 |         NEW %DT,X,Y SET %DT="P"  ;"P-Post dates assumed
 | 
|---|
| 246 |         SET X=TMGDOB DO ^%DT SET TMGDOB=Y  ;"convert external date into internal format
 | 
|---|
| 247 |         IF +TMGDOB'>0 DO  GOTO PSEDONE
 | 
|---|
| 248 |         . SET TMGRESULT="0^Invalid date: "_$GET(TMGARRAY(.03))
 | 
|---|
| 249 |  ;
 | 
|---|
| 250 |         NEW TMGMATCHES MERGE TMGMATCHES=^DPT("B",TMGNAME)
 | 
|---|
| 251 |         IF $DATA(TMGMATCHES)=0 DO  GOTO PSEDONE
 | 
|---|
| 252 |         . SET TMGRESULT="0^No match for name"
 | 
|---|
| 253 |  ;
 | 
|---|
| 254 |         ;"Now compare each name match for also matching sex and DOB
 | 
|---|
| 255 |         NEW TMGIEN SET TMGIEN=""
 | 
|---|
| 256 |         FOR  SET TMGIEN=$ORDER(TMGMATCHES(TMGIEN)) QUIT:(+TMGIEN'>0)  DO
 | 
|---|
| 257 |         . NEW TMGNODE0 SET TMGNODE0=$GET(^DPT(TMGIEN,0))
 | 
|---|
| 258 |         . IF $PIECE(TMGNODE0,"^",2)'=TMGSEX DO  QUIT
 | 
|---|
| 259 |         . . KILL TMGMATCHES(TMGIEN)
 | 
|---|
| 260 |         . IF $PIECE(TMGNODE0,"^",3)'=TMGDOB DO  QUIT
 | 
|---|
| 261 |         . . KILL TMGMATCHES(TMGIEN)
 | 
|---|
| 262 |  ;
 | 
|---|
| 263 |         ;"TMGMATCHES should contain all entries matching name+sex+DOB
 | 
|---|
| 264 |         SET TMGRESULT=+$ORDER(TMGMATCHES(""))
 | 
|---|
| 265 |         ;"Now check for more than one match
 | 
|---|
| 266 |         IF $ORDER(TMGMATCHES(TMGRESULT))'="" DO  GOTO PSEDONE
 | 
|---|
| 267 |         . SET TMGRESULT="0^More than one match found for Name+Sex+DOB"
 | 
|---|
| 268 |  ;
 | 
|---|
| 269 | PSEDONE ;
 | 
|---|
| 270 |         QUIT TMGRESULT
 | 
|---|
| 271 |  ;
 | 
|---|
| 272 |  ;
 | 
|---|