| 1 | HLUCM050 ;CIOFO-O/LJA - HL7/Capacity Mgt API-II ;10/23/01 12:01
|
|---|
| 2 | ;;1.6;HEALTH LEVEL SEVEN;**103,114**;Oct 13, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | LOADEM(IEN772,HLNMSP) ; Find all related entries, up to 20...
|
|---|
| 5 | ; HLNMSP is passed by reference...
|
|---|
| 6 | ;
|
|---|
| 7 | ; Note! If entry already loaded, it will not be reloaded.
|
|---|
| 8 | ; (Stored ^TMP($J) data will be used instead.)
|
|---|
| 9 | ;
|
|---|
| 10 | N ACKTO,CHARC,CHARP,CT,DATA,DATAC,DATAP,DEF,FAC,HL,HLZZI
|
|---|
| 11 | N HOLDNMSP,I,I772,I773,IEN,IENPAR,LEN,MSGID,MTYPEC
|
|---|
| 12 | N MTYPEP,NMSP,NMSPP,NUM,PIEN,PROT,PROTP,TIME,TIMEBEG
|
|---|
| 13 | N TIMEEND,TMDIFF,TMP,TOT772,TOT773,TOTNUM,X,Y
|
|---|
| 14 | ;
|
|---|
| 15 | KILL HLNMSP
|
|---|
| 16 | ;
|
|---|
| 17 | ; Call already made here?
|
|---|
| 18 | S IENPAR=+$G(^TMP($J,"HLCHILD",+IEN772)) ; Call already made here?
|
|---|
| 19 | ;
|
|---|
| 20 | ; If call already made, just return results...
|
|---|
| 21 | I IENPAR D QUIT $P(HLNMSP("HLPARENT",+IENPAR),U,2) ;->
|
|---|
| 22 | . S HLNMSP("HLPARENT",+IENPAR)=$G(^TMP($J,"HLPARENT",+IENPAR))
|
|---|
| 23 | . ; HL*1.6*114 added TOTNUM to next 3 lines to avoid ALLOC errors...
|
|---|
| 24 | . S IEN772=0,TOTNUM=0
|
|---|
| 25 | . F S IEN772=$O(^TMP($J,"HLPARENT",IENPAR,IEN772)) Q:'IEN772!(TOTNUM>19) D
|
|---|
| 26 | . . S TOTNUM=TOTNUM+1
|
|---|
| 27 | . . S HLNMSP("HLPARENT",+IENPAR,IEN772)=$G(^TMP($J,"HLPARENT",IENPAR,IEN772))
|
|---|
| 28 | . . S HLNMSP("HLCHILD",+IEN772)=$G(^TMP($J,"HLCHILD",+IEN772))
|
|---|
| 29 | ;
|
|---|
| 30 | S HLNMSP(+IEN772)="" ; Seed for engine...
|
|---|
| 31 | ;
|
|---|
| 32 | S (NUM,TOTNUM)=1
|
|---|
| 33 | F D QUIT:NUM'>NUM(1)!(TOTNUM>19)
|
|---|
| 34 | . S NUM(1)=NUM ; Set NUM(1) = # entries found "now"...
|
|---|
| 35 | . KILL HOLDNMSP
|
|---|
| 36 | . S I772=0
|
|---|
| 37 | . F S I772=$O(HLNMSP(I772)) Q:I772'>0!(TOTNUM>19) D
|
|---|
| 38 | . . S DATA=$G(^HL(772,+$G(I772),0)) QUIT:DATA']"" ;->
|
|---|
| 39 | . .
|
|---|
| 40 | . . ; IEN Search...
|
|---|
| 41 | . . S HLZZI=0 F S HLZZI=$O(^HL(772,"AF",I772,HLZZI)) Q:'HLZZI!(TOTNUM>19) I HLZZI'=IEN772 D HOLDTOT(HLZZI)
|
|---|
| 42 | . . ; MSG ID search...
|
|---|
| 43 | . . S MSGID=$P(DATA,U,6)
|
|---|
| 44 | . . I MSGID]"" D
|
|---|
| 45 | . . . S HLZZI=0 F S HLZZI=$O(^HL(772,"C",MSGID,HLZZI)) Q:'HLZZI!(TOTNUM>19) I HLZZI'=IEN772 D HOLDTOT(HLZZI)
|
|---|
| 46 | . . . D MSGID(MSGID)
|
|---|
| 47 | . . ; 773 MSG ID search...
|
|---|
| 48 | . . S I773=+$O(^HLMA("B",I772,0)) I I773 D
|
|---|
| 49 | . . . S MSGID=$P($G(^HLMA(+I773,0)),U,2) QUIT:MSGID']"" ;->
|
|---|
| 50 | . . . S I773(1)=0
|
|---|
| 51 | . . . F S I773(1)=$O(^HLMA("AF",I773,I773(1))) Q:I773(1)'>0!(TOTNUM>19) D
|
|---|
| 52 | . . . . S X=+$G(^HLMA(+I773(1),0)) I X D HOLDTOT(+X)
|
|---|
| 53 | . . . S I773(1)=0
|
|---|
| 54 | . . . F S I773(1)=$O(^HLMA("C",MSGID,I773(1))) Q:I773(1)'>0!(TOTNUM>19) D
|
|---|
| 55 | . . . . S X=+$G(^HLMA(+I773(1),0)) I X D HOLDTOT(+X)
|
|---|
| 56 | . . . KILL I773(1)
|
|---|
| 57 | . . . D MSGID(MSGID)
|
|---|
| 58 | . .
|
|---|
| 59 | . . ;
|
|---|
| 60 | . . ; ACK TO search...
|
|---|
| 61 | . . I $P(DATA,U,7)>0,$P(DATA,U,7)'=IEN772 D
|
|---|
| 62 | . . . D HOLDTOT(+$P(DATA,U,7))
|
|---|
| 63 | . . I I773 D
|
|---|
| 64 | . . . S ACKTO=$P($G(^HLMA(+I773,0)),U,10) QUIT:ACKTO'>0 ;->
|
|---|
| 65 | . . . S X=+$G(^HLMA(+ACKTO,0)) I X D HOLDTOT(+X)
|
|---|
| 66 | . . ;
|
|---|
| 67 | . . ; HLPARENT search...
|
|---|
| 68 | . . I $P(DATA,U,8)>0,$P(DATA,U,8)'=IEN772 D
|
|---|
| 69 | . . . D HOLDTOT(+$P(DATA,U,8))
|
|---|
| 70 | . . I I773 D
|
|---|
| 71 | . . . S PIEN=$P($G(^HLMA(+I773,0)),U,6) QUIT:PIEN'>0 ;->
|
|---|
| 72 | . . . S X=+$G(^HLMA(+PIEN,0)) I X D HOLDTOT(+X)
|
|---|
| 73 | . .
|
|---|
| 74 | . . MERGE HLNMSP=HOLDNMSP
|
|---|
| 75 | . . KILL HOLDNMSP
|
|---|
| 76 | .
|
|---|
| 77 | . S I=0,NUM=0 F S I=$O(HLNMSP(I)) Q:'I S NUM=NUM+1
|
|---|
| 78 | ;
|
|---|
| 79 | I '$$OKALL(.HLNMSP) D QUIT "" ;->
|
|---|
| 80 | . KILL HLNMSP
|
|---|
| 81 | ;
|
|---|
| 82 | S FAC=$$FACILITY^HLUCM090(.HLNMSP) I FAC']"" S FAC="UNKNOWN"
|
|---|
| 83 | S IENPAR=$O(HLNMSP(0))
|
|---|
| 84 | ;
|
|---|
| 85 | ; Find total number characters...
|
|---|
| 86 | KILL TIMEP
|
|---|
| 87 | S IEN772=0,CHARC=0,CHARP=0,CT=0,MTYPEP="",NMSPP="",PROTP="",NUM=0
|
|---|
| 88 | F S IEN772=$O(HLNMSP(IEN772)) Q:'IEN772 D
|
|---|
| 89 | . S CT=CT+1,NUM=NUM+1
|
|---|
| 90 | .
|
|---|
| 91 | . S TMP($J,"HLPARENT",+IENPAR,+IEN772)=$$VAL3(+IEN772,FAC)_U_IENPAR
|
|---|
| 92 | .
|
|---|
| 93 | . S CHARC=$$CHAR(+IEN772)
|
|---|
| 94 | . S DATAC(IEN772)=CHARC
|
|---|
| 95 | . S CHARP=CHARP+CHARC
|
|---|
| 96 | .
|
|---|
| 97 | . S $P(DATAC(IEN772),U,2)=1
|
|---|
| 98 | .
|
|---|
| 99 | . S TIME=$$TIME(+IEN772)
|
|---|
| 100 | . F I=1:1:3 S $P(DATAC(IEN772),U,2+I)=$P(TIME,U,I)
|
|---|
| 101 | . F I=2,3 S X=$P(TIME,U,I) I X?7N.E S TIMEP(X)=""
|
|---|
| 102 | .
|
|---|
| 103 | . S MTYPEC=$$MSGTYPE^HLUCM009(IEN772)
|
|---|
| 104 | . S $P(DATAC(IEN772),U,6)=MTYPEC
|
|---|
| 105 | . S MTYPEP=MTYPEP_$S(MTYPEP]"":"~",1:"")_MTYPEC
|
|---|
| 106 | .
|
|---|
| 107 | . S PROT=$$PROT101^HLUCM002(+IEN772)
|
|---|
| 108 | . S $P(DATAC(IEN772),U,7)=PROT
|
|---|
| 109 | . S:PROT]"" PROTP=PROT
|
|---|
| 110 | .
|
|---|
| 111 | . S NMSP=$$NMSPALL(+IEN772)
|
|---|
| 112 | . S $P(DATAC(IEN772),U,9)=NMSP
|
|---|
| 113 | . I NMSP]"" D
|
|---|
| 114 | . . I NMSPP]"",NMSP="XWB",NMSPP'="XWB" QUIT ;->
|
|---|
| 115 | . . S NMSPP=NMSP
|
|---|
| 116 | .
|
|---|
| 117 | . S $P(DATAC(IEN772),U,11)=FAC
|
|---|
| 118 | ;
|
|---|
| 119 | S TIMEBEG=$O(TIMEP(0)),TIMEEND=$O(TIMEP(":"),-1)
|
|---|
| 120 | S TMDIFF=$$FMDIFF^XLFDT(TIMEEND,TIMEBEG,2)
|
|---|
| 121 | ;
|
|---|
| 122 | S DATAP=CHARP_U_CT_U_TMDIFF_U_TIMEBEG_U_TIMEEND_U_MTYPEP_U_PROTP_U_U_NMSPP_U_U_FAC
|
|---|
| 123 | ;
|
|---|
| 124 | ; Set PARENT node...
|
|---|
| 125 | S IENPAR=$O(HLNMSP(0))
|
|---|
| 126 | S TMP($J,"HLPARENT",+IENPAR)=DATAP
|
|---|
| 127 | ;
|
|---|
| 128 | ; Set CHILD nodes...
|
|---|
| 129 | S IEN772=0
|
|---|
| 130 | F S IEN772=$O(HLNMSP(IEN772)) Q:IEN772'>0 D
|
|---|
| 131 | . S TMP($J,"HLCHILD",+IEN772)=IENPAR_"~"_$G(DATAC(+IEN772))
|
|---|
| 132 | ;
|
|---|
| 133 | KILL HLNMSP
|
|---|
| 134 | MERGE HLNMSP=TMP($J)
|
|---|
| 135 | MERGE ^TMP($J)=TMP($J)
|
|---|
| 136 | ;
|
|---|
| 137 | Q NUM
|
|---|
| 138 | ;
|
|---|
| 139 | OKALL(HLNMSP) ; Does every 772 entry have a valid .01 node?
|
|---|
| 140 | N FAIL,I772
|
|---|
| 141 | S FAIL=0,I772=0
|
|---|
| 142 | F S I772=$O(HLNMSP(I772)) Q:'I772!(FAIL) D
|
|---|
| 143 | . QUIT:$P($G(^HL(772,+I772,0)),U)?7N1"."1.N ;->
|
|---|
| 144 | . S FAIL=1
|
|---|
| 145 | Q 'FAIL
|
|---|
| 146 | ;
|
|---|
| 147 | VAL3(IEN772,FAC) ; Return sort values...
|
|---|
| 148 | N TYPEHR,TYPEIO,TYPELR
|
|---|
| 149 | S TYPEHR=$$TYPETMO^HLUCM002(+IEN772)
|
|---|
| 150 | S TYPEIO=$$TYPEIO^HLUCM002(+IEN772)
|
|---|
| 151 | ;S TYPELR=$$TYPELR^HLUCM001(+IEN772,FAC)
|
|---|
| 152 | S TYPELR=$S(FAC["~DNS":"R",1:"L")
|
|---|
| 153 | Q TYPEHR_U_TYPEIO_U_TYPELR
|
|---|
| 154 | ;
|
|---|
| 155 | TIME(IEN772) ; Times...
|
|---|
| 156 | N CT,DATA,IEN773,TMBEG,TMEND,TMDIFF
|
|---|
| 157 | D TOT772T^HLUCM(+IEN772)
|
|---|
| 158 | S IEN773=0,CT=0
|
|---|
| 159 | F S IEN773=$O(^HLMA("B",+IEN772,IEN773)) Q:'IEN773!(CT>20) D
|
|---|
| 160 | . S CT=CT+1
|
|---|
| 161 | . D TOT773T^HLUCM(+IEN773)
|
|---|
| 162 | D TMDIFF^HLUCM
|
|---|
| 163 | Q DATA("DIFF")_U_DATA("START")_U_DATA("END")
|
|---|
| 164 | ;
|
|---|
| 165 | ;
|
|---|
| 166 | CHAR(IEN772) ; Number characters...
|
|---|
| 167 | N CT,DATA,IEN773
|
|---|
| 168 | D TOT772C^HLUCM(+IEN772)
|
|---|
| 169 | S IEN773=0,CT=0
|
|---|
| 170 | F S IEN773=$O(^HLMA("B",+IEN772,IEN773)) Q:'IEN773!(CT>20) D
|
|---|
| 171 | . S CT=CT+1
|
|---|
| 172 | . D TOT773C^HLUCM(+IEN773)
|
|---|
| 173 | Q $G(DATA("CHAR"))
|
|---|
| 174 | ;
|
|---|
| 175 | GETNMSP(IEN772) ; The one and only place to ask for NAMESPACE...
|
|---|
| 176 | N HL,NMSP,NUM,PAR,VAL
|
|---|
| 177 | S NUM=$$LOADEM^HLUCM050(+IEN772,.HL) QUIT:NUM'>0 "" ;->
|
|---|
| 178 | S PAR=+$G(HL("HLCHILD",+IEN772))
|
|---|
| 179 | S VAL=$G(HL("HLPARENT",+PAR))
|
|---|
| 180 | Q $P(VAL,U,9)
|
|---|
| 181 | ;
|
|---|
| 182 | GETPROT(IEN772) ; One & only place to ask for PROTOCOL...
|
|---|
| 183 | N HL,NMSP,NUM,PAR,VAL
|
|---|
| 184 | S NUM=$$LOADEM^HLUCM050(+IEN772,.HL) QUIT:NUM'>0 "" ;->
|
|---|
| 185 | S PAR=+$G(HL("HLCHILD",+IEN772))
|
|---|
| 186 | S VAL=$G(HL("HLPARENT",+PAR))
|
|---|
| 187 | Q $P(VAL,U,7)
|
|---|
| 188 | ;
|
|---|
| 189 | HOLDTOT(X) D HOLDTOT^HLUCM009(X) QUIT
|
|---|
| 190 | MSGID(X) D MSGID^HLUCM009(X) QUIT
|
|---|
| 191 | ;
|
|---|
| 192 | NMSPALL(IEN772) ;Perform all attempts to find NMSP...
|
|---|
| 193 | N IEN101,IEN94,NMSP
|
|---|
| 194 | ;
|
|---|
| 195 | ; If SPR...
|
|---|
| 196 | S NMSP=$$SPR(+IEN772) QUIT:NMSP]"" $$NMSPCHG(NMSP) ;->
|
|---|
| 197 | ;
|
|---|
| 198 | ; Check MSH segment...
|
|---|
| 199 | S NMSP=$$MSH772^HLUCM003(+IEN772) QUIT:NMSP]"" $$NMSPCHG(NMSP) ;->
|
|---|
| 200 | S NMSP=$$MSHMAIL^HLUCM003(+IEN772) QUIT:NMSP]"" $$NMSPCHG(NMSP) ;->
|
|---|
| 201 | ;
|
|---|
| 202 | ; Get Event Protocol
|
|---|
| 203 | S IEN101=+$P($G(^HL(772,+IEN772,0)),U,10) QUIT:IEN101'>0 "" ;->
|
|---|
| 204 | ;
|
|---|
| 205 | ; Find XEC routines, and try NMSPXRFs...
|
|---|
| 206 | S NMSP=$$NMSPXRF(+IEN101) QUIT:NMSP]"" $$NMSPCHG(NMSP) ;->
|
|---|
| 207 | ;
|
|---|
| 208 | ; Try 9.4 link...
|
|---|
| 209 | S IEN94=$P($G(^ORD(101,+IEN101,0)),U,12)
|
|---|
| 210 | I IEN94 S NMSP=$P($$NMSP94(IEN94),U,2) QUIT:NMSP]"" $$NMSPCHG(NMSP) ;->
|
|---|
| 211 | ;
|
|---|
| 212 | S NMSP=$$MSH773^HLUCM003(+IEN772) QUIT:NMSP]"" $$NMSPCHG(NMSP) ;->
|
|---|
| 213 | ;
|
|---|
| 214 | QUIT ""
|
|---|
| 215 | ;
|
|---|
| 216 | NMSP94(IEN94) ; From 9.4 find it's namespace...
|
|---|
| 217 | N D0,DA,DIC,DIQ,DR,NMSP,RET
|
|---|
| 218 | S RET=$G(^TMP($J,"HLNMSP94",+IEN94)) I RET]"" QUIT RET ;->
|
|---|
| 219 | S DIC=9.4,DR=".01;1",DA=IEN94,DIQ="NMSP(",DIQ(0)="E"
|
|---|
| 220 | D EN^DIQ1
|
|---|
| 221 | S RET=$G(NMSP(9.4,+IEN94,.01,"E"))_U_$G(NMSP(9.4,+IEN94,1,"E"))
|
|---|
| 222 | S ^TMP($J,"HLNMSP94",+IEN94)=RET
|
|---|
| 223 | QUIT RET
|
|---|
| 224 | ;
|
|---|
| 225 | NMSPCHG(NMSP) ; Some miscellaneous special actions first...
|
|---|
| 226 | N PCKG
|
|---|
| 227 | ;
|
|---|
| 228 | ; Check xref first...
|
|---|
| 229 | D:'$D(^TMP($J,"HLNMSPXRF")) NMSPXRF^HLUCM009
|
|---|
| 230 | S PCKG=$$NMSPFROM(NMSP) QUIT:PCKG]"" PCKG ;->
|
|---|
| 231 | ;
|
|---|
| 232 | S PCKG=NMSP
|
|---|
| 233 | ;
|
|---|
| 234 | ; Other conversions here...
|
|---|
| 235 | I $E(PCKG,1,2)="DG",PCKG'="DG" S PCKG="DG"
|
|---|
| 236 | I $E(PCKG,1,3)="VEI",PCKG'="VEIB" S PCKG="VEIB"
|
|---|
| 237 | I $E(PCKG,1,2)="VA" D
|
|---|
| 238 | . I PCKG["PIMS" S PCKG="DG" QUIT ;->
|
|---|
| 239 | . I $G(APPR)["HEC " S PCKG="HEC" QUIT ;->
|
|---|
| 240 | . I $G(FACR)["HEC " S PCKG="HEC" QUIT ;->
|
|---|
| 241 | I $E(PCKG,1,2)="LA" S PCKG="LA"
|
|---|
| 242 | I $E(PCKG,1,2)="VA",PCKG[" PIMS" S PCKG="DG"
|
|---|
| 243 | I $E(PCKG,1,10)="VAFC ADMIT" S PCKG="DG"
|
|---|
| 244 | I $E(PCKG,1,8)="VAFC ADT" S PCKG="DG"
|
|---|
| 245 | I $E(PCKG,1,8)?1"VAFH A"2N S PCKG="DG"
|
|---|
| 246 | I $E(PCKG,1,15)?1"VAFH CLIENT A"2N S PCKG="DG"
|
|---|
| 247 | I $E(PCKG,1,2)="XM" S PCKG="XM"
|
|---|
| 248 | I $E(PCKG,1,2)="XU" S PCKG="XU"
|
|---|
| 249 | ;
|
|---|
| 250 | QUIT PCKG
|
|---|
| 251 | ;
|
|---|
| 252 | NMSPXRF(IEN101) ; Find NMSP from ^TMP($J,"NMSPXRF")
|
|---|
| 253 | N LEN,NMSP,NODE,RTN
|
|---|
| 254 | I '$D(^TMP($J,"HLNMSPXRF")) D NMSPXRF^HLUCM009 ; Build, if not there
|
|---|
| 255 | S NMSP=""
|
|---|
| 256 | F NODE=772,774,771 D QUIT:NMSP]""
|
|---|
| 257 | . S RTN=$E($P($G(^ORD(101,+IEN101,NODE)),U,2),1,4) QUIT:RTN']"" ;->
|
|---|
| 258 | . S NMSP=$$NMSPFROM(RTN)
|
|---|
| 259 | Q NMSP
|
|---|
| 260 | ;
|
|---|
| 261 | NMSPFROM(TXT) ; From TXT try to find NMSP...
|
|---|
| 262 | N NMSP
|
|---|
| 263 | QUIT:$G(TXT)']"" "" ;->
|
|---|
| 264 | S NMSP=""
|
|---|
| 265 | F LEN=4:-1:2 D QUIT:NMSP]""
|
|---|
| 266 | . S NMSP=$G(^TMP($J,"HLNMSPXRF",$E(TXT,1,LEN))) QUIT:NMSP]"" ;->
|
|---|
| 267 | I NMSP']"" F LEN=4:-1:2 D QUIT:NMSP]""
|
|---|
| 268 | . ; See Integration Agreement #10048
|
|---|
| 269 | . N D,DIC,X,Y
|
|---|
| 270 | . S DIC="^DIC(9.4,",DIC(0)="FO",D="C",X=$E(TXT,1,LEN)
|
|---|
| 271 | . D MIX^DIC1 QUIT:+Y'>0 ;->
|
|---|
| 272 | . ; Found! So, set into ^TMP...
|
|---|
| 273 | . S NMSP=$E(TXT,1,LEN)
|
|---|
| 274 | . S ^TMP($J,"HLNMSPXRF",NMSP)=NMSP
|
|---|
| 275 | Q NMSP
|
|---|
| 276 | ;
|
|---|
| 277 | SPR(IEN772) ; Evaluate SPR segment for RPC for package, possible
|
|---|
| 278 | ; resetting the PCKG variable...
|
|---|
| 279 | ; PCKG -- req
|
|---|
| 280 | N CHAR,DEL,IN,NMSP
|
|---|
| 281 | S IN=$G(^HL(772,+IEN772,"IN",1,0))
|
|---|
| 282 | QUIT:$E(IN,1,4)'="SPR^" "" ;->
|
|---|
| 283 | QUIT:IN'["REMOTE RPC^" "" ;->
|
|---|
| 284 | S DEL=$E(IN,4)
|
|---|
| 285 | S IN=$P(IN,DEL,5) QUIT:IN']"" "" ;->
|
|---|
| 286 | S IN=$P(IN,"003RPC",2) QUIT:IN']"" "" ;->
|
|---|
| 287 | S CHAR=+IN,IN=$TR($E(IN,4,CHAR+4),"&","") QUIT:IN']"" "" ;->
|
|---|
| 288 | I $E(IN,1,2)="IB" QUIT "IB" ;->
|
|---|
| 289 | I $E(IN,1,2)="OR" QUIT "OR" ;->
|
|---|
| 290 | I '$D(^TMP($J,"HLNMSPXRF")) D NMSPXRF^HLUCM009
|
|---|
| 291 | S NMSP=$$NMSPFROM(IN)
|
|---|
| 292 | QUIT NMSP
|
|---|
| 293 | ;
|
|---|
| 294 | EOR ; HLUCM050 - HL7/Capacity Mgt API-II ;10/23/01 12:01
|
|---|
