Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HLUCM050

HLUCM050.m

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