Routine: HLUCM009

HLUCM009 ;CIOFO-O/LJA - HL7/Capacity Mgt API-II ;2/25/03-08:50

 ;;1.6;HEALTH LEVEL SEVEN;**103**;Oct 13, 1995

IEN870(IEN772) ; Given 772 find 870...

 N DATA,I773,I870,IEN

 S DATA=$G(^HL(772,+IEN772,0))

 ; Logical Link field...

 S IEN=$P(DATA,U,11) I IEN QUIT IEN ;->

 ; Related Event Protocol...

 S IEN=$P(DATA,U,10),IEN=$P($G(^ORD(101,+IEN,770)),U,7) I IEN QUIT IEN ;->

 S I773=0

 F  S I773=$O(^HLMA("B",IEN772,I773)) Q:I773'>0  D  QUIT:I870

 .  S I870=$P($G(^HLMA(+I773,0)),U,7)

 I $G(I870) QUIT +I870 ;->

 QUIT ""

MSGTYPE(IEN772) ; MSG or MSA's type...

 N DEL,IN

 S IN=$G(^HL(772,+IEN772,"IN",1,0)) QUIT:IN']"" "MSG" ;->

 S DEL=$E(IN,4) QUIT:DEL']"" "MSG" ;->

 S IN=$P(IN,DEL,2) QUIT:IN']"" "MSG" ;->

 I $L(IN)=2,$E(IN)="C"!($E(IN)="A") QUIT IN ;->

 QUIT "MSG"

KILLS(WHEN) ; Kills of ^TMP data WHEN (START or END or ALL)

 N DATA

 ; If ALL, set WHEN to include START and END...

 S:WHEN="ALL" WHEN="STARTandEND"

 ; Always KILLs...

 F DATA="ACTUAL","HLCHILD",$G(TOTALS)_"ERRTIME","HLOAD772","N","HLNMSP94","HLNMSPXRF","HLPARENT","HLRECNM","U","X" D

 .  KILL ^TMP(DATA,$J),^TMP($J,DATA)

 ; START-only KILLs...

 I WHEN["START" D

 .  F DATA="HLUCMSTORE","RFAC",$G(TOTALS) D

 .  .  QUIT:DATA']""  ;-> Sometimes TOTALS might not be defined

 .  .  KILL ^TMP(DATA,$J),^TMP($J,DATA)

 ; END-only KILLs...

 I WHEN["END" D

 .  KILL HLAPI

 .  ; Don't store any debug global data...

 .  I $G(^TMP($J,"HLUCM"))'="DEBUG GLOBAL" KILL ^TMP($J)

 .  F DATA="HL4","HLUCM","HLUCMDT" D

 .  .  KILL ^TMP($J,DATA),^TMP(DATA,$J)

 QUIT

SITESMSH(TXT) ; Return location pieces, slightly modified...

 N DIV,P4,P6

 S DIV=$E(TXT,4),P4=$P(TXT,DIV,4),P6=$P(TXT,DIV,6)

 S P4=$S(P4?1.N1"~"!(P4?1.N):+P4,1:"")

 S P6=$S(P6?1.N1"~"!(P6?1.N):+P6,1:"")

 QUIT P4_U_P6

MAILTYPE(MIEN) ; Is MSH in Mailman message local or remote...

 N IEN,RECNO,TO,TOID,TYPE

 S TYPE="L"

 KILL ^TMP($J,"HLMAILTYPE")

 D QD^XMXUTIL3(+MIEN,,,,,"^TMP($J,""HLMAILTYPE"")")

 S RECNO=0

 F  S RECNO=$O(^TMP($J,"HLMAILTYPE","XMLIST",RECNO)) Q:RECNO'>0!(TYPE'="L")  D

 .  S TO=$G(^TMP($J,"HLMAILTYPE","XMLIST",+RECNO,"TO"))

 .  S TOID=$G(^TMP($J,"HLMAILTYPE","XMLIST",+RECNO,"TO ID"))

 .  I TO["@"!(TOID="R") S TYPE="R"

 KILL ^TMP($J,"HLMAILTYPE")

 QUIT TYPE

NMSPXRF ; Xref of namespaces that can be inferred. (If start with DG change to DG)

 N I,T KILL ^TMP($J,"HLNMSPXRF") F I=2:1 S T=$T(NMSPXRF+I) Q:T'[";;"  S T=$P(T,";;",2,99),^TMP($J,"HLNMSPXRF",$P(T,U))=$P(T,U,2)

 ;;DG^DG

 ;;GM^GM

 ;;HEC^HEC

 ;;IB^IB

 ;;IVM^IVM

 ;;LA^LA

 ;;MPI^MPI

 ;;OR^OR

 ;;PR^PR

 ;;PS^PS

 ;;RG^RG

 ;;ROR^ROR

 ;;SC^SC

 ;;VEI^VEIB

 ;;XM^XMB

 ;;XU^XU

 ;;XW^XWB

ACCUMLAT(CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3,SUB4) ; Generic accumulator

 I $G(SUB4)]"" D

 .  S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3,SUB4))

 .  D INCR^HLUCM001

 .  S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3,SUB4)=TOTCURR

 S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3))

 D INCR^HLUCM001

 S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3)=TOTCURR

 ; Totals level 2 for SUB...

 S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2))

 D INCR^HLUCM001

 S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1,SUB2)=TOTCURR

 ; Totals level 1 for SUB...

 S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1))

 D INCR^HLUCM001

 S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT,SUB1)=TOTCURR

 ; Total level TYPE/SORT...

 S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE,SORT))

 D INCR^HLUCM001

 S ^TMP(TOTALS,$J,CATEGORY,TYPE,SORT)=TOTCURR

 ; Total level TYPE

 S TOTCURR=$G(^TMP(TOTALS,$J,CATEGORY,TYPE))

 D INCR^HLUCM001

 S ^TMP(TOTALS,$J,CATEGORY,TYPE)=TOTCURR

 ; Total level CATEGORY

 ; [Don't subtotal here, for NMSP holds two different TYPEs, and

 ; if totalled here, it would double count.]

 QUIT

LOAD772S(IEN772,HLNMSP) ; Load list of related 772s... [HL*1.6*91]

 ; Warning!!!  This call point will never load more than 20 entries...

 ;             Any more than that, and probably an error condition

 ;             exists.

 N ACKTO,CHILD,DATA,FAC,HL772,HLI,HLJ,HLK,HLN,HLPCKG,HLZZI,HOLDNMSP,I

 N I772,I773,MSGID,NUM,PARENT,PCKG,PIEN,PROT,TOTNUM,VAL,X

 KILL HLNMSP

 QUIT:$G(^HL(772,+$G(IEN772),0))']"" "" ;->

 S DATA=$G(^HL(772,+$G(IEN772),0)) QUIT:DATA']"" "" ;->

 ; Loop until no new entries found or more than 20 entries...

 S NUM=$$LOADEM^HLUCM050(+IEN772,.HLNMSP)

 QUIT NUM

HOLDTOT(IEN) ; Accumulate...

 QUIT:$D(HOLDNMSP(IEN))!(TOTNUM>19)  ;->

 S HOLDNMSP(IEN)="",TOTNUM=TOTNUM+1

 QUIT

SETUP() ; Perform checks, which can return error conditions, and

 ; set up variables for $$LOOP.  This extrinsic function returns

 ; "" if no errors, or the # errors found.  (Note that error

 ; details placed in ERRINFO(ERROR-REASON)="")

 N NOERR

 S NOERR=""

 D SETDEF ; Set defaults for parameters, if not passed

 D FINDWAY ; Find way NMSP and PROT parameters passed

 D SETMORE^HLUCM003 ; Additional var sets based on parameters & "way"...

 D ERRCHK^HLUCM003 ; Check for errors...

 KILL ^TMP(TOTALS,$J) ; Clear out storage location...

 QUIT NOERR

SETDEF ; Set various defaults...

 I '$D(PNMSP) S PNMSP=1

 I '$D(IEN101) S IEN101=1

 I $G(TOTALS)']"" S TOTALS="HLTOTALS"

 S COND=$$UP^XLFSTR(COND)

 S COND=$S($G(COND)="BOTH":COND,1:"EITHER") ; Default to EITHER matches, count it...

 QUIT

FINDWAY ; How were NMSP and PROT passed?  By reference?  (If so, return 1)

 ; Passed by reference?

 S NMSPTYPE=$S($G(PNMSP)']""&($O(PNMSP(""))]""):1,1:0) ; 1=YES

 S PROTYPE=$S($G(IEN101)']""&($O(IEN101(""))]""):1,1:0) ; 1=YES

 QUIT

MSGID(MSGID) ; Search forward for MSA's to this MSGID...

 N BIEN,CT,D,HOLD,I772,I773,MSA,X

 S X=$O(^HL(772,"C",MSGID,0)) I X S HOLD(X)=""

 S X=$O(^HLMA("C",MSGID,0)) I X S X=+$G(^HLMA(+X,0)) I X S HOLD(X)=""

ERRMOVE(IEN772) ; Move all associated data out of ^TMP's totaling arrays

 N IEN772C,IEN772P

 ; Find parent message (because have to move ALL associated messages out)

 QUIT:$G(^TMP($J,"HLUCM"))'="DEBUG GLOBAL"  ;->

 S IEN772P=$O(^TMP($J,"HLUCMSTORE","X",+IEN772,0))

 I IEN772P'>0 S IEN772P=IEN772

 ; Loop thru all associated messages in unit...

 S IEN772C=0

 F  S IEN772C=$O(^TMP($J,"HLUCMSTORE","U",IEN772P,IEN772C)) Q:'IEN772C  D

 .  F SUB="C","E","O","X" D

 .  .  MERGE ^TMP($J,"HLUCMSTORE","ERR",SUB,IEN772C)=^TMP($J,"HLUCMSTORE",SUB,IEN772C)

 .  .  KILL ^TMP($J,"HLUCMSTORE",SUB,IEN772C)

 ; Maybe there is no X xref...

 MERGE ^TMP($J,"HLUCMSTORE","ERR","E",+IEN772P)=^TMP($J,"HLUCMSTORE","E",+IEN772P)

 KILL ^TMP($J,"HLUCMSTORE","E",+IEN772P)

 ; Finally, move the unit's data...

 MERGE ^TMP($J,"HLUCMSTORE","ERR","U",IEN772P)=^TMP($J,"HLUCMSTORE","U",IEN772P)

 KILL ^TMP($J,"HLUCMSTORE","U",IEN772P)

EOR ;HLUCM009 - HL7/Capacity Mgt API-II ;2/25/03-08:50

HLUCM009.m