| 1 | RGFIU ;ALB/CJM-MPI/PD NDBI MERGE UTILITY (CONTINUED) ;08/27/99
|
|---|
| 2 | ;;1.0;CLINICAL INFO RESOURCE NETWORK;**5,13,25**;30 Apr 99
|
|---|
| 3 | ;
|
|---|
| 4 | STATNUM(IEN) ;
|
|---|
| 5 | ;Description: Given an ien to the Institution file, returns as the function value the station number. Returns "" on failure.
|
|---|
| 6 | ;
|
|---|
| 7 | N STATION
|
|---|
| 8 | Q:'$G(IEN) ""
|
|---|
| 9 | Q:'$D(^DIC(4,IEN,0)) ""
|
|---|
| 10 | S STATION=$P($$NNT^XUAF4(IEN),"^",2)
|
|---|
| 11 | Q $S(+STATION:STATION,1:"")
|
|---|
| 12 | ;
|
|---|
| 13 | UPD(FILE,RGDA,DATA,ERROR) ;File data into an existing record.
|
|---|
| 14 | ; Input:
|
|---|
| 15 | ; FILE - File or sub-file number
|
|---|
| 16 | ; RGDA - New name for traditional DA array, with same meaning.
|
|---|
| 17 | ; Pass by reference.
|
|---|
| 18 | ; DATA - Data array to file (pass by reference)
|
|---|
| 19 | ; Format: DATA(<field #>)=<value>
|
|---|
| 20 | ;
|
|---|
| 21 | ; Output:
|
|---|
| 22 | ; Function Value - 0=error and 1=no error
|
|---|
| 23 | ; ERROR - optional error message - if needed, pass by reference
|
|---|
| 24 | ;
|
|---|
| 25 | ; Example: To update a record in subfile 2.0361 in record with ien=353,
|
|---|
| 26 | ; subrecord ien=68, with the field .01 value = 21:
|
|---|
| 27 | ; S DATA(.01)=21,RGDA=68,RGDA(1)=353 I $$UPD^RGFIU(2.0361,.RGDA,.DATA,.ERROR) W !,"DONE"
|
|---|
| 28 | ;
|
|---|
| 29 | N FDA,FIELD,IENS,ERRORS
|
|---|
| 30 | ;
|
|---|
| 31 | ;IENS - Internal Entry Number String defined by FM
|
|---|
| 32 | ;FDA - the FDA array as defined by FM
|
|---|
| 33 | ;
|
|---|
| 34 | I '$G(RGDA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q 0
|
|---|
| 35 | S IENS=$$IENS^DILF(.RGDA)
|
|---|
| 36 | S FIELD=0
|
|---|
| 37 | F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
|
|---|
| 38 | .S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
|
|---|
| 39 | D FILE^DIE("K","FDA","ERRORS(1)")
|
|---|
| 40 | I +$G(DIERR) D
|
|---|
| 41 | .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
|
|---|
| 42 | E D
|
|---|
| 43 | .S ERROR=""
|
|---|
| 44 | ;
|
|---|
| 45 | I $S(+$G(DIERR):0,1:1) D CLEAN^DILF Q 1
|
|---|
| 46 | E D CLEAN^DILF Q 0
|
|---|
| 47 | ;
|
|---|
| 48 | GETFIELD(FILE,FIELD,RGDA,ERROR,EXT) ;Get field value from an existing record.
|
|---|
| 49 | ; Input:
|
|---|
| 50 | ; FILE - File or sub-file number
|
|---|
| 51 | ; RGDA - New name for traditional DA array, with same meaning.
|
|---|
| 52 | ; Pass by reference.
|
|---|
| 53 | ; FIELD - Field for which value is needed
|
|---|
| 54 | ; EXT - (optional) If $G(EXT) then returns the external display form of the value
|
|---|
| 55 | ; Output:
|
|---|
| 56 | ; Function Value - field value in internal format,"" if an error was encountered
|
|---|
| 57 | ; ERROR - optional error message - if needed, pass by reference
|
|---|
| 58 | ;
|
|---|
| 59 | N FDA,IENS,ERRORS,VALUE
|
|---|
| 60 | ;
|
|---|
| 61 | ;IENS - Internal Entry Number String defined by FM
|
|---|
| 62 | ;FDA - the FDA array as defined by FM
|
|---|
| 63 | ;
|
|---|
| 64 | I '$G(RGDA) S ERROR="IEN OF RECORD TO BE UPDATED NOT SPECIFIED" Q ""
|
|---|
| 65 | S IENS=$$IENS^DILF(.RGDA)
|
|---|
| 66 | S VALUE=$$GET1^DIQ(FILE,IENS,FIELD,$S($G(EXT):"",1:"I"),,"ERRORS(1)")
|
|---|
| 67 | I +$G(DIERR) D
|
|---|
| 68 | .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
|
|---|
| 69 | E D
|
|---|
| 70 | .S ERROR=""
|
|---|
| 71 | ;
|
|---|
| 72 | I $S(+$G(DIERR):0,1:1) D CLEAN^DILF Q VALUE
|
|---|
| 73 | E D CLEAN^DILF Q ""
|
|---|
| 74 | ;
|
|---|
| 75 | DELETE(FILE,RGDA,ERROR) ;Delete an existing record.
|
|---|
| 76 | ; Input:
|
|---|
| 77 | ; FILE - File or sub-file number
|
|---|
| 78 | ; RGDA - New name for traditional DA array, with same meaning.
|
|---|
| 79 | ; Pass by reference.
|
|---|
| 80 | ;
|
|---|
| 81 | ; Output:
|
|---|
| 82 | ; Function Value - 0=error and 1=no error
|
|---|
| 83 | ; ERROR - optional error message - if needed, pass by reference
|
|---|
| 84 | ;
|
|---|
| 85 | ; Example: To delete a record in subfile 2.0361 in record with ien=353,
|
|---|
| 86 | ; subrecord ien=68:
|
|---|
| 87 | ; S RGDA=68,RGDA(1)=353 I $$DELETE^RGFIU(2.0361,.RGDA,.DATA,.ERROR) W !,"DONE"
|
|---|
| 88 | ;
|
|---|
| 89 | N DATA
|
|---|
| 90 | S DATA(.01)="@"
|
|---|
| 91 | Q $$UPD^RGFIU(FILE,.RGDA,.DATA,.ERROR)
|
|---|
| 92 | Q
|
|---|
| 93 | ;
|
|---|
| 94 | ADD(FILE,RGDA,DATA,ERROR,IEN) ;
|
|---|
| 95 | ;Description: Creates a new record and files the data.
|
|---|
| 96 | ; Input:
|
|---|
| 97 | ; FILE - File or sub-file number
|
|---|
| 98 | ; RGDA - New name for traditional FileMan DA array with same
|
|---|
| 99 | ; meaning. Pass by reference. Only needed if adding to a
|
|---|
| 100 | ; subfile.
|
|---|
| 101 | ; DATA - Data array to file, pass by reference
|
|---|
| 102 | ; Format: DATA(<field #>)=<value>
|
|---|
| 103 | ; IEN - internal entry number to use (optional)
|
|---|
| 104 | ;
|
|---|
| 105 | ; Output:
|
|---|
| 106 | ; Function Value - If no error then it returns the ien of the created record, else returns NULL.
|
|---|
| 107 | ; RGDA - returns the ien of the new record, NULL if none created. If needed, pass by reference.
|
|---|
| 108 | ; ERROR - optional error message - if needed, pass by reference
|
|---|
| 109 | ;
|
|---|
| 110 | ; Example: To add a record in subfile 2.0361 in the record with ien=353
|
|---|
| 111 | ; with the field .01 value = 21:
|
|---|
| 112 | ; S DATA(.01)=21,RGDA(1)=353 I $$ADD^RGFIU(2.0361,.RGDA,.DATA) W !,"DONE"
|
|---|
| 113 | ;
|
|---|
| 114 | ; Example: If creating a record not in a subfile, would look like this:
|
|---|
| 115 | ; S DATA(.01)=21 I $$ADD^RGFIU(867,,.DATA) W !,"DONE"
|
|---|
| 116 | ;
|
|---|
| 117 | N FDA,FIELD,IENA,IENS,ERRORS
|
|---|
| 118 | ;
|
|---|
| 119 | ;IENS - Internal Entry Number String defined by FM
|
|---|
| 120 | ;IENA - the Internal Entry Numebr Array defined by FM
|
|---|
| 121 | ;FDA - the FDA array defined by FM
|
|---|
| 122 | ;IEN - the ien of the new record
|
|---|
| 123 | ;
|
|---|
| 124 | S RGDA="+1"
|
|---|
| 125 | S IENS=$$IENS^DILF(.RGDA)
|
|---|
| 126 | S FIELD=0
|
|---|
| 127 | F S FIELD=$O(DATA(FIELD)) Q:'FIELD D
|
|---|
| 128 | .S FDA(FILE,IENS,FIELD)=$G(DATA(FIELD))
|
|---|
| 129 | I $G(IEN) S IENA(1)=IEN
|
|---|
| 130 | D UPDATE^DIE("","FDA","IENA","ERRORS(1)")
|
|---|
| 131 | I +$G(DIERR) D
|
|---|
| 132 | .S ERROR=$G(ERRORS(1,"DIERR",1,"TEXT",1))
|
|---|
| 133 | .S IEN=""
|
|---|
| 134 | E D
|
|---|
| 135 | .S IEN=IENA(1)
|
|---|
| 136 | .S ERROR=""
|
|---|
| 137 | D CLEAN^DILF
|
|---|
| 138 | S RGDA=IEN
|
|---|
| 139 | Q IEN
|
|---|
| 140 | ;
|
|---|
| 141 | TESTVAL(FILE,FIELD,VALUE) ;
|
|---|
| 142 | ;Description: returns 1 if VALUE is a valid value for FIELD in FILE
|
|---|
| 143 | ;
|
|---|
| 144 | Q:(('$G(FILE))!('$G(FIELD))) 0
|
|---|
| 145 | ;
|
|---|
| 146 | N DISPLAY,VALID,RESULT
|
|---|
| 147 | S VALID=1
|
|---|
| 148 | ;
|
|---|
| 149 | ;if there is no external value then it is not valid
|
|---|
| 150 | S DISPLAY=$$EXTERNAL^DILFD(FILE,FIELD,"F",VALUE)
|
|---|
| 151 | I (DISPLAY="") S VALID=0
|
|---|
| 152 | ;
|
|---|
| 153 | I VALID,$$GET1^DID(FILE,FIELD,"","TYPE")'["POINTER" D
|
|---|
| 154 | .D CHK^DIE(FILE,FIELD,,VALUE,.RESULT) I RESULT="^" S VALID=0 Q
|
|---|
| 155 | Q VALID
|
|---|
| 156 | ;
|
|---|
| 157 | GETLINK(INSTIEN) ;
|
|---|
| 158 | ;Description: Returns name of logical link for institition, given the institution ien. Returns "" if a logical link name not found.
|
|---|
| 159 | ;
|
|---|
| 160 | Q:'$G(INSTIEN) ""
|
|---|
| 161 | ;
|
|---|
| 162 | N LINK,I,LINKNAME
|
|---|
| 163 | S LINKNAME=""
|
|---|
| 164 | D
|
|---|
| 165 | .;don't check if enabled - if shut down, message will be queued
|
|---|
| 166 | .;Q:'$$CHKLL^HLUTIL(INSTIEN)
|
|---|
| 167 | .;
|
|---|
| 168 | .D LINK^HLUTIL3(INSTIEN,.LINK)
|
|---|
| 169 | .S I=$O(LINK(0))
|
|---|
| 170 | .I I,$L(LINK(I)) S LINKNAME=LINK(I)
|
|---|
| 171 | Q LINKNAME
|
|---|
| 172 | ;
|
|---|
| 173 | ASKYESNO(PROMPT,DEFAULT) ;
|
|---|
| 174 | ;Description: Displays PROMPT, appending '?'. Expects a YES NO response.
|
|---|
| 175 | ;Input:
|
|---|
| 176 | ; PROMPT - text to display as prompt. Appends '?'
|
|---|
| 177 | ; DEFAULT - (optional) YES or NO. If not passed, defaults to YES
|
|---|
| 178 | ;Output:
|
|---|
| 179 | ; Function value: 1 if yes, 0 if no, "" if '^' entered or timeout
|
|---|
| 180 | ;
|
|---|
| 181 | N DIR,Y
|
|---|
| 182 | S DIR(0)="Y"
|
|---|
| 183 | S DIR("A")=PROMPT
|
|---|
| 184 | S DIR("B")=$S($G(DEFAULT)="NO":"NO",1:"YES")
|
|---|
| 185 | D ^DIR
|
|---|
| 186 | Q:$D(DIRUT) ""
|
|---|
| 187 | Q Y
|
|---|
| 188 | ;
|
|---|
| 189 | EXC(RGEXC,RGERR,RGDFN,RGMSGID,RGSITE) ;
|
|---|
| 190 | ;Description: Calls the MPI/PD Exception Handler
|
|---|
| 191 | ;Inputs:
|
|---|
| 192 | ; RGEXC - the exception type
|
|---|
| 193 | ; RGERR - (optional) text
|
|---|
| 194 | ; RGDFN - (optional) patient DFN
|
|---|
| 195 | ; RGMSGID - (optional) HL7 message id
|
|---|
| 196 | ; RGSITE - (optional) station # of site where the exception occurred
|
|---|
| 197 | N ICN
|
|---|
| 198 | I +$G(RGDFN) D
|
|---|
| 199 | .S ICN=+$$GETICN^MPIF001(RGDFN)
|
|---|
| 200 | .I ICN'>0 S ICN=""
|
|---|
| 201 | .S RGERR=$G(RGERR)_" Patient Name: "_$E($$NAME(RGDFN),1,25)_" SSN: "_$$SSN(RGDFN)_" ICN: "_ICN
|
|---|
| 202 | D EXC^RGHLLOG($G(RGEXC),$E($G(RGERR),1,235),$G(RGDFN),$G(RGMSGID),$G(RGSITE))
|
|---|
| 203 | Q
|
|---|
| 204 | ;
|
|---|
| 205 | SSN(DFN) ;
|
|---|
| 206 | ;Description: Function returns the patient's SSN, or "" on failure.
|
|---|
| 207 | Q $$GETFIELD(2,.09,.DFN)
|
|---|
| 208 | ;
|
|---|
| 209 | NAME(DFN) ;
|
|---|
| 210 | ;Description: Function returns the patient's NAME, or "" on failure.
|
|---|
| 211 | Q $$GETFIELD(2,.01,.DFN)
|
|---|
| 212 | ;
|
|---|
| 213 | ICN(DFN) ;Return patient ICN
|
|---|
| 214 | NEW RESULT
|
|---|
| 215 | S RESULT=+$$GETICN^MPIF001($G(DFN))
|
|---|
| 216 | I RESULT<0 Q ""
|
|---|
| 217 | Q +RESULT
|
|---|
| 218 | ;
|
|---|
| 219 | DFN(ICN) ;Return patient IEN
|
|---|
| 220 | NEW RESULT
|
|---|
| 221 | I ICN'="" S ICN=+ICN
|
|---|
| 222 | S RESULT=$$GETDFN^MPIF001($G(ICN))
|
|---|
| 223 | I RESULT<0 Q ""
|
|---|
| 224 | Q RESULT
|
|---|
| 225 | ;
|
|---|
| 226 | MPINODE(DFN) ;
|
|---|
| 227 | N NODE
|
|---|
| 228 | S NODE=$$MPINODE^MPIFAPI($G(DFN))
|
|---|
| 229 | I +NODE=-1 S NODE=""
|
|---|
| 230 | Q NODE
|
|---|
| 231 | ;
|
|---|
| 232 | GETALL(DFN,MPIDATA) ;
|
|---|
| 233 | ;Descripition: Gets the MPI data and treating facility list
|
|---|
| 234 | ;
|
|---|
| 235 | ;Input:
|
|---|
| 236 | ; DFN - patient ien
|
|---|
| 237 | ;Output:
|
|---|
| 238 | ; MPIDATA - output array (pass by reference)
|
|---|
| 239 | ; "ICN") = <ICN>
|
|---|
| 240 | ; "CHKSUM") = <ICN checksum>
|
|---|
| 241 | ; "LOC") = <1 if ICN is local, 0 if national>
|
|---|
| 242 | ; "CMOR") = <station number of CMOR>
|
|---|
| 243 | ; "TF",<station number of TF>,"INSTIEN")=<ien of treating facility in Institution file>
|
|---|
| 244 | ; "TF",<station number of TF>,"LASTDATE")=<date last treated>
|
|---|
| 245 | ; "TF",<station number of TF>,"EVENT")=<ADT event reason (a pointer)>
|
|---|
| 246 | ; "SUB") = <ien of subscriber list>
|
|---|
| 247 | ;
|
|---|
| 248 | N NODE,IEN,STAT,INST,LINK,I,HLL
|
|---|
| 249 | ;
|
|---|
| 250 | K MPIDATA
|
|---|
| 251 | ;
|
|---|
| 252 | ;get MPI data
|
|---|
| 253 | S NODE=$$MPINODE^RGFIU(DFN)
|
|---|
| 254 | S MPIDATA("ICN")=$P(NODE,"^"),MPIDATA("CHKSUM")=$P(NODE,"^",2),MPIDATA("LOC")=$P(NODE,"^",4),MPIDATA("CMOR")=$$STATNUM^RGFIU($P(NODE,"^",3)),MPIDATA("SUB")=$P(NODE,"^",5)
|
|---|
| 255 | ;
|
|---|
| 256 | ;get TF list
|
|---|
| 257 | I MPIDATA("ICN") D
|
|---|
| 258 | .N ARRAY,ITEM,NODE,STAT
|
|---|
| 259 | .Q:$$QUERYTF^VAFCTFU1(MPIDATA("ICN"),"ARRAY")
|
|---|
| 260 | .S ITEM=0
|
|---|
| 261 | .F S ITEM=$O(ARRAY(ITEM)) Q:'ITEM D
|
|---|
| 262 | ..S NODE=ARRAY(ITEM)
|
|---|
| 263 | ..S STAT=$$STATNUM^RGFIU($P(NODE,"^"))
|
|---|
| 264 | ..Q:'STAT
|
|---|
| 265 | ..S MPIDATA("TF",STAT,"INSTIEN")=$P(NODE,"^",1)
|
|---|
| 266 | ..S MPIDATA("TF",STAT,"LASTDATE")=$P(NODE,"^",2)
|
|---|
| 267 | ..S MPIDATA("TF",STAT,"EVENT")=$P(NODE,"^",3)
|
|---|
| 268 | Q
|
|---|
