HLUCM050 ;CIOFO-O/LJA - HL7/Capacity Mgt API-II ;10/23/01 12:01
;;1.6;HEALTH LEVEL SEVEN;**103,114**;Oct 13, 1995
;
LOADEM(IEN772,HLNMSP) ; Find all related entries, up to 20...
; HLNMSP is passed by reference...
;
; Note! If entry already loaded, it will not be reloaded.
; (Stored ^TMP($J) data will be used instead.)
;
N ACKTO,CHARC,CHARP,CT,DATA,DATAC,DATAP,DEF,FAC,HL,HLZZI
N HOLDNMSP,I,I772,I773,IEN,IENPAR,LEN,MSGID,MTYPEC
N MTYPEP,NMSP,NMSPP,NUM,PIEN,PROT,PROTP,TIME,TIMEBEG
N TIMEEND,TMDIFF,TMP,TOT772,TOT773,TOTNUM,X,Y
;
KILL HLNMSP
;
; Call already made here?
S IENPAR=+$G(^TMP($J,"HLCHILD",+IEN772)) ; Call already made here?
;
; If call already made, just return results...
I IENPAR D QUIT $P(HLNMSP("HLPARENT",+IENPAR),U,2) ;->
. S HLNMSP("HLPARENT",+IENPAR)=$G(^TMP($J,"HLPARENT",+IENPAR))
. ; HL*1.6*114 added TOTNUM to next 3 lines to avoid ALLOC errors...
. S IEN772=0,TOTNUM=0
. F S IEN772=$O(^TMP($J,"HLPARENT",IENPAR,IEN772)) Q:'IEN772!(TOTNUM>19) D
. . S TOTNUM=TOTNUM+1
. . S HLNMSP("HLPARENT",+IENPAR,IEN772)=$G(^TMP($J,"HLPARENT",IENPAR,IEN772))
. . S HLNMSP("HLCHILD",+IEN772)=$G(^TMP($J,"HLCHILD",+IEN772))
;
S HLNMSP(+IEN772)="" ; Seed for engine...
;
S (NUM,TOTNUM)=1
F D QUIT:NUM'>NUM(1)!(TOTNUM>19)
. S NUM(1)=NUM ; Set NUM(1) = # entries found "now"...
. KILL HOLDNMSP
. S I772=0
. F S I772=$O(HLNMSP(I772)) Q:I772'>0!(TOTNUM>19) D
. . S DATA=$G(^HL(772,+$G(I772),0)) QUIT:DATA']"" ;->
. .
. . ; IEN Search...
. . S HLZZI=0 F S HLZZI=$O(^HL(772,"AF",I772,HLZZI)) Q:'HLZZI!(TOTNUM>19) I HLZZI'=IEN772 D HOLDTOT(HLZZI)
. . ; MSG ID search...
. . S MSGID=$P(DATA,U,6)
. . I MSGID]"" D
. . . S HLZZI=0 F S HLZZI=$O(^HL(772,"C",MSGID,HLZZI)) Q:'HLZZI!(TOTNUM>19) I HLZZI'=IEN772 D HOLDTOT(HLZZI)
. . . D MSGID(MSGID)
. . ; 773 MSG ID search...
. . S I773=+$O(^HLMA("B",I772,0)) I I773 D
. . . S MSGID=$P($G(^HLMA(+I773,0)),U,2) QUIT:MSGID']"" ;->
. . . S I773(1)=0
. . . F S I773(1)=$O(^HLMA("AF",I773,I773(1))) Q:I773(1)'>0!(TOTNUM>19) D
. . . . S X=+$G(^HLMA(+I773(1),0)) I X D HOLDTOT(+X)
. . . S I773(1)=0
. . . F S I773(1)=$O(^HLMA("C",MSGID,I773(1))) Q:I773(1)'>0!(TOTNUM>19) D
. . . . S X=+$G(^HLMA(+I773(1),0)) I X D HOLDTOT(+X)
. . . KILL I773(1)
. . . D MSGID(MSGID)
. .
. . ;
. . ; ACK TO search...
. . I $P(DATA,U,7)>0,$P(DATA,U,7)'=IEN772 D
. . . D HOLDTOT(+$P(DATA,U,7))
. . I I773 D
. . . S ACKTO=$P($G(^HLMA(+I773,0)),U,10) QUIT:ACKTO'>0 ;->
. . . S X=+$G(^HLMA(+ACKTO,0)) I X D HOLDTOT(+X)
. . ;
. . ; HLPARENT search...
. . I $P(DATA,U,8)>0,$P(DATA,U,8)'=IEN772 D
. . . D HOLDTOT(+$P(DATA,U,8))
. . I I773 D
. . . S PIEN=$P($G(^HLMA(+I773,0)),U,6) QUIT:PIEN'>0 ;->
. . . S X=+$G(^HLMA(+PIEN,0)) I X D HOLDTOT(+X)
. .
. . MERGE HLNMSP=HOLDNMSP
. . KILL HOLDNMSP
.
. S I=0,NUM=0 F S I=$O(HLNMSP(I)) Q:'I S NUM=NUM+1
;
I '$$OKALL(.HLNMSP) D QUIT "" ;->
. KILL HLNMSP
;
S FAC=$$FACILITY^HLUCM090(.HLNMSP) I FAC']"" S FAC="UNKNOWN"
S IENPAR=$O(HLNMSP(0))
;
; Find total number characters...
KILL TIMEP
S IEN772=0,CHARC=0,CHARP=0,CT=0,MTYPEP="",NMSPP="",PROTP="",NUM=0
F S IEN772=$O(HLNMSP(IEN772)) Q:'IEN772 D
. S CT=CT+1,NUM=NUM+1
.
. S TMP($J,"HLPARENT",+IENPAR,+IEN772)=$$VAL3(+IEN772,FAC)_U_IENPAR
.
. S CHARC=$$CHAR(+IEN772)
. S DATAC(IEN772)=CHARC
. S CHARP=CHARP+CHARC
.
. S $P(DATAC(IEN772),U,2)=1
.
. S TIME=$$TIME(+IEN772)
. F I=1:1:3 S $P(DATAC(IEN772),U,2+I)=$P(TIME,U,I)
. F I=2,3 S X=$P(TIME,U,I) I X?7N.E S TIMEP(X)=""
.
. S MTYPEC=$$MSGTYPE^HLUCM009(IEN772)
. S $P(DATAC(IEN772),U,6)=MTYPEC
. S MTYPEP=MTYPEP_$S(MTYPEP]"":"~",1:"")_MTYPEC
.
. S PROT=$$PROT101^HLUCM002(+IEN772)
. S $P(DATAC(IEN772),U,7)=PROT
. S:PROT]"" PROTP=PROT
.
. S NMSP=$$NMSPALL(+IEN772)
. S $P(DATAC(IEN772),U,9)=NMSP
. I NMSP]"" D
. . I NMSPP]"",NMSP="XWB",NMSPP'="XWB" QUIT ;->
. . S NMSPP=NMSP
.
. S $P(DATAC(IEN772),U,11)=FAC
;
S TIMEBEG=$O(TIMEP(0)),TIMEEND=$O(TIMEP(":"),-1)
S TMDIFF=$$FMDIFF^XLFDT(TIMEEND,TIMEBEG,2)
;
S DATAP=CHARP_U_CT_U_TMDIFF_U_TIMEBEG_U_TIMEEND_U_MTYPEP_U_PROTP_U_U_NMSPP_U_U_FAC
;
; Set PARENT node...
S IENPAR=$O(HLNMSP(0))
S TMP($J,"HLPARENT",+IENPAR)=DATAP
;
; Set CHILD nodes...
S IEN772=0
F S IEN772=$O(HLNMSP(IEN772)) Q:IEN772'>0 D
. S TMP($J,"HLCHILD",+IEN772)=IENPAR_"~"_$G(DATAC(+IEN772))
;
KILL HLNMSP
MERGE HLNMSP=TMP($J)
MERGE ^TMP($J)=TMP($J)
;
Q NUM
;
OKALL(HLNMSP) ; Does every 772 entry have a valid .01 node?
N FAIL,I772
S FAIL=0,I772=0
F S I772=$O(HLNMSP(I772)) Q:'I772!(FAIL) D
. QUIT:$P($G(^HL(772,+I772,0)),U)?7N1"."1.N ;->
. S FAIL=1
Q 'FAIL
;
VAL3(IEN772,FAC) ; Return sort values...
N TYPEHR,TYPEIO,TYPELR
S TYPEHR=$$TYPETMO^HLUCM002(+IEN772)
S TYPEIO=$$TYPEIO^HLUCM002(+IEN772)
;S TYPELR=$$TYPELR^HLUCM001(+IEN772,FAC)
S TYPELR=$S(FAC["~DNS":"R",1:"L")
Q TYPEHR_U_TYPEIO_U_TYPELR
;
TIME(IEN772) ; Times...
N CT,DATA,IEN773,TMBEG,TMEND,TMDIFF
D TOT772T^HLUCM(+IEN772)
S IEN773=0,CT=0
F S IEN773=$O(^HLMA("B",+IEN772,IEN773)) Q:'IEN773!(CT>20) D
. S CT=CT+1
. D TOT773T^HLUCM(+IEN773)
D TMDIFF^HLUCM
Q DATA("DIFF")_U_DATA("START")_U_DATA("END")
;
;
CHAR(IEN772) ; Number characters...
N CT,DATA,IEN773
D TOT772C^HLUCM(+IEN772)
S IEN773=0,CT=0
F S IEN773=$O(^HLMA("B",+IEN772,IEN773)) Q:'IEN773!(CT>20) D
. S CT=CT+1
. D TOT773C^HLUCM(+IEN773)
Q $G(DATA("CHAR"))
;
GETNMSP(IEN772) ; The one and only place to ask for NAMESPACE...
N HL,NMSP,NUM,PAR,VAL
S NUM=$$LOADEM^HLUCM050(+IEN772,.HL) QUIT:NUM'>0 "" ;->
S PAR=+$G(HL("HLCHILD",+IEN772))
S VAL=$G(HL("HLPARENT",+PAR))
Q $P(VAL,U,9)
;
GETPROT(IEN772) ; One & only place to ask for PROTOCOL...
N HL,NMSP,NUM,PAR,VAL
S NUM=$$LOADEM^HLUCM050(+IEN772,.HL) QUIT:NUM'>0 "" ;->
S PAR=+$G(HL("HLCHILD",+IEN772))
S VAL=$G(HL("HLPARENT",+PAR))
Q $P(VAL,U,7)
;
HOLDTOT(X) D HOLDTOT^HLUCM009(X) QUIT
MSGID(X) D MSGID^HLUCM009(X) QUIT
;
NMSPALL(IEN772) ;Perform all attempts to find NMSP...
N IEN101,IEN94,NMSP
;
; If SPR...
S NMSP=$$SPR(+IEN772) QUIT:NMSP]"" $$NMSPCHG(NMSP) ;->
;
; Check MSH segment...
S NMSP=$$MSH772^HLUCM003(+IEN772) QUIT:NMSP]"" $$NMSPCHG(NMSP) ;->
S NMSP=$$MSHMAIL^HLUCM003(+IEN772) QUIT:NMSP]"" $$NMSPCHG(NMSP) ;->
;
; Get Event Protocol
S IEN101=+$P($G(^HL(772,+IEN772,0)),U,10) QUIT:IEN101'>0 "" ;->
;
; Find XEC routines, and try NMSPXRFs...
S NMSP=$$NMSPXRF(+IEN101) QUIT:NMSP]"" $$NMSPCHG(NMSP) ;->
;
; Try 9.4 link...
S IEN94=$P($G(^ORD(101,+IEN101,0)),U,12)
I IEN94 S NMSP=$P($$NMSP94(IEN94),U,2) QUIT:NMSP]"" $$NMSPCHG(NMSP) ;->
;
S NMSP=$$MSH773^HLUCM003(+IEN772) QUIT:NMSP]"" $$NMSPCHG(NMSP) ;->
;
QUIT ""
;
NMSP94(IEN94) ; From 9.4 find it's namespace...
N D0,DA,DIC,DIQ,DR,NMSP,RET
S RET=$G(^TMP($J,"HLNMSP94",+IEN94)) I RET]"" QUIT RET ;->
S DIC=9.4,DR=".01;1",DA=IEN94,DIQ="NMSP(",DIQ(0)="E"
D EN^DIQ1
S RET=$G(NMSP(9.4,+IEN94,.01,"E"))_U_$G(NMSP(9.4,+IEN94,1,"E"))
S ^TMP($J,"HLNMSP94",+IEN94)=RET
QUIT RET
;
NMSPCHG(NMSP) ; Some miscellaneous special actions first...
N PCKG
;
; Check xref first...
D:'$D(^TMP($J,"HLNMSPXRF")) NMSPXRF^HLUCM009
S PCKG=$$NMSPFROM(NMSP) QUIT:PCKG]"" PCKG ;->
;
S PCKG=NMSP
;
; Other conversions here...
I $E(PCKG,1,2)="DG",PCKG'="DG" S PCKG="DG"
I $E(PCKG,1,3)="VEI",PCKG'="VEIB" S PCKG="VEIB"
I $E(PCKG,1,2)="VA" D
. I PCKG["PIMS" S PCKG="DG" QUIT ;->
. I $G(APPR)["HEC " S PCKG="HEC" QUIT ;->
. I $G(FACR)["HEC " S PCKG="HEC" QUIT ;->
I $E(PCKG,1,2)="LA" S PCKG="LA"
I $E(PCKG,1,2)="VA",PCKG[" PIMS" S PCKG="DG"
I $E(PCKG,1,10)="VAFC ADMIT" S PCKG="DG"
I $E(PCKG,1,8)="VAFC ADT" S PCKG="DG"
I $E(PCKG,1,8)?1"VAFH A"2N S PCKG="DG"
I $E(PCKG,1,15)?1"VAFH CLIENT A"2N S PCKG="DG"
I $E(PCKG,1,2)="XM" S PCKG="XM"
I $E(PCKG,1,2)="XU" S PCKG="XU"
;
QUIT PCKG
;
NMSPXRF(IEN101) ; Find NMSP from ^TMP($J,"NMSPXRF")
N LEN,NMSP,NODE,RTN
I '$D(^TMP($J,"HLNMSPXRF")) D NMSPXRF^HLUCM009 ; Build, if not there
S NMSP=""
F NODE=772,774,771 D QUIT:NMSP]""
. S RTN=$E($P($G(^ORD(101,+IEN101,NODE)),U,2),1,4) QUIT:RTN']"" ;->
. S NMSP=$$NMSPFROM(RTN)
Q NMSP
;
NMSPFROM(TXT) ; From TXT try to find NMSP...
N NMSP
QUIT:$G(TXT)']"" "" ;->
S NMSP=""
F LEN=4:-1:2 D QUIT:NMSP]""
. S NMSP=$G(^TMP($J,"HLNMSPXRF",$E(TXT,1,LEN))) QUIT:NMSP]"" ;->
I NMSP']"" F LEN=4:-1:2 D QUIT:NMSP]""
. ; See Integration Agreement #10048
. N D,DIC,X,Y
. S DIC="^DIC(9.4,",DIC(0)="FO",D="C",X=$E(TXT,1,LEN)
. D MIX^DIC1 QUIT:+Y'>0 ;->
. ; Found! So, set into ^TMP...
. S NMSP=$E(TXT,1,LEN)
. S ^TMP($J,"HLNMSPXRF",NMSP)=NMSP
Q NMSP
;
SPR(IEN772) ; Evaluate SPR segment for RPC for package, possible
; resetting the PCKG variable...
; PCKG -- req
N CHAR,DEL,IN,NMSP
S IN=$G(^HL(772,+IEN772,"IN",1,0))
QUIT:$E(IN,1,4)'="SPR^" "" ;->
QUIT:IN'["REMOTE RPC^" "" ;->
S DEL=$E(IN,4)
S IN=$P(IN,DEL,5) QUIT:IN']"" "" ;->
S IN=$P(IN,"003RPC",2) QUIT:IN']"" "" ;->
S CHAR=+IN,IN=$TR($E(IN,4,CHAR+4),"&","") QUIT:IN']"" "" ;->
I $E(IN,1,2)="IB" QUIT "IB" ;->
I $E(IN,1,2)="OR" QUIT "OR" ;->
I '$D(^TMP($J,"HLNMSPXRF")) D NMSPXRF^HLUCM009
S NMSP=$$NMSPFROM(IN)
QUIT NMSP
;
EOR ; HLUCM050 - HL7/Capacity Mgt API-II ;10/23/01 12:01