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
 Q
 ;
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)=""
 ;
 Q
 ;
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)
 ;
 Q
 ;
EOR ;HLUCM009 - HL7/Capacity Mgt API-II ;2/25/03-08:50
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLUCM009   6918     printed  Sep 23, 2025@19:36:22                                                                                                                                                                                                    Page 2
HLUCM009  ;CIOFO-O/LJA - HL7/Capacity Mgt API-II ;2/25/03-08:50
 +1       ;;1.6;HEALTH LEVEL SEVEN;**103**;Oct 13, 1995
 +2       ;
IEN870(IEN772) ; Given 772 find 870...
 +1        NEW DATA,I773,I870,IEN
 +2        SET DATA=$GET(^HL(772,+IEN772,0))
 +3       ;
 +4       ; Logical Link field...
 +5       ;->
           SET IEN=$PIECE(DATA,U,11)
           IF IEN
               QUIT IEN
 +6       ;
 +7       ; Related Event Protocol...
 +8       ;->
           SET IEN=$PIECE(DATA,U,10)
           SET IEN=$PIECE($GET(^ORD(101,+IEN,770)),U,7)
           IF IEN
               QUIT IEN
 +9       ;
 +10       SET I773=0
 +11       FOR 
               SET I773=$ORDER(^HLMA("B",IEN772,I773))
               if I773'>0
                   QUIT 
               Begin DoDot:1
 +12               SET I870=$PIECE($GET(^HLMA(+I773,0)),U,7)
               End DoDot:1
               if I870
                   QUIT 
 +13      ;->
           IF $GET(I870)
               QUIT +I870
 +14      ;
 +15       QUIT ""
 +16      ;
MSGTYPE(IEN772) ; MSG or MSA's type...
 +1        NEW DEL,IN
 +2       ;->
           SET IN=$GET(^HL(772,+IEN772,"IN",1,0))
           if IN']""
               QUIT "MSG"
 +3       ;->
           SET DEL=$EXTRACT(IN,4)
           if DEL']""
               QUIT "MSG"
 +4       ;->
           SET IN=$PIECE(IN,DEL,2)
           if IN']""
               QUIT "MSG"
 +5       ;->
           IF $LENGTH(IN)=2
               IF $EXTRACT(IN)="C"!($EXTRACT(IN)="A")
                   QUIT IN
 +6        QUIT "MSG"
 +7       ;
KILLS(WHEN) ; Kills of ^TMP data WHEN (START or END or ALL)
 +1        NEW DATA
 +2       ;
 +3       ; If ALL, set WHEN to include START and END...
 +4        if WHEN="ALL"
               SET WHEN="STARTandEND"
 +5       ;
 +6       ; Always KILLs...
 +7        FOR DATA="ACTUAL","HLCHILD",$GET(TOTALS)_"ERRTIME","HLOAD772","N","HLNMSP94","HLNMSPXRF","HLPARENT","HLRECNM","U","X"
               Begin DoDot:1
 +8                KILL ^TMP(DATA,$JOB),^TMP($JOB,DATA)
               End DoDot:1
 +9       ;
 +10      ; START-only KILLs...
 +11       IF WHEN["START"
               Begin DoDot:1
 +12               FOR DATA="HLUCMSTORE","RFAC",$GET(TOTALS)
                       Begin DoDot:2
 +13      ;-> Sometimes TOTALS might not be defined
                           if DATA']""
                               QUIT 
 +14                       KILL ^TMP(DATA,$JOB),^TMP($JOB,DATA)
                       End DoDot:2
               End DoDot:1
 +15      ;
 +16      ; END-only KILLs...
 +17       IF WHEN["END"
               Begin DoDot:1
 +18               KILL HLAPI
 +19      ; Don't store any debug global data...
 +20               IF $GET(^TMP($JOB,"HLUCM"))'="DEBUG GLOBAL"
                       KILL ^TMP($JOB)
 +21               FOR DATA="HL4","HLUCM","HLUCMDT"
                       Begin DoDot:2
 +22                       KILL ^TMP($JOB,DATA),^TMP(DATA,$JOB)
                       End DoDot:2
               End DoDot:1
 +23      ;
 +24       QUIT 
 +25      ;
SITESMSH(TXT) ; Return location pieces, slightly modified...
 +1        NEW DIV,P4,P6
 +2        SET DIV=$EXTRACT(TXT,4)
           SET P4=$PIECE(TXT,DIV,4)
           SET P6=$PIECE(TXT,DIV,6)
 +3        SET P4=$SELECT(P4?1.N1"~"!(P4?1.N):+P4,1:"")
 +4        SET P6=$SELECT(P6?1.N1"~"!(P6?1.N):+P6,1:"")
 +5        QUIT P4_U_P6
 +6       ;
MAILTYPE(MIEN) ; Is MSH in Mailman message local or remote...
 +1        NEW IEN,RECNO,TO,TOID,TYPE
 +2        SET TYPE="L"
 +3        KILL ^TMP($JOB,"HLMAILTYPE")
 +4        DO QD^XMXUTIL3(+MIEN,,,,,"^TMP($J,""HLMAILTYPE"")")
 +5        SET RECNO=0
 +6        FOR 
               SET RECNO=$ORDER(^TMP($JOB,"HLMAILTYPE","XMLIST",RECNO))
               if RECNO'>0!(TYPE'="L")
                   QUIT 
               Begin DoDot:1
 +7                SET TO=$GET(^TMP($JOB,"HLMAILTYPE","XMLIST",+RECNO,"TO"))
 +8                SET TOID=$GET(^TMP($JOB,"HLMAILTYPE","XMLIST",+RECNO,"TO ID"))
 +9                IF TO["@"!(TOID="R")
                       SET TYPE="R"
               End DoDot:1
 +10       KILL ^TMP($JOB,"HLMAILTYPE")
 +11       QUIT TYPE
 +12      ;
NMSPXRF   ; Xref of namespaces that can be inferred. (If start with DG change to DG)
 +1        NEW I,T
           KILL ^TMP($JOB,"HLNMSPXRF")
           FOR I=2:1
               SET T=$TEXT(NMSPXRF+I)
               if T'[";;"
                   QUIT 
               SET T=$PIECE(T,";;",2,99)
               SET ^TMP($JOB,"HLNMSPXRF",$PIECE(T,U))=$PIECE(T,U,2)
 +2       ;;DG^DG
 +3       ;;GM^GM
 +4       ;;HEC^HEC
 +5       ;;IB^IB
 +6       ;;IVM^IVM
 +7       ;;LA^LA
 +8       ;;MPI^MPI
 +9       ;;OR^OR
 +10      ;;PR^PR
 +11      ;;PS^PS
 +12      ;;RG^RG
 +13      ;;ROR^ROR
 +14      ;;SC^SC
 +15      ;;VEI^VEIB
 +16      ;;XM^XMB
 +17      ;;XU^XU
 +18      ;;XW^XWB
 +19       QUIT 
 +20      ;
ACCUMLAT(CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3,SUB4) ; Generic accumulator
 +1       ;
 +2        IF $GET(SUB4)]""
               Begin DoDot:1
 +3                SET TOTCURR=$GET(^TMP(TOTALS,$JOB,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3,SUB4))
 +4                DO INCR^HLUCM001
 +5                SET ^TMP(TOTALS,$JOB,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3,SUB4)=TOTCURR
               End DoDot:1
 +6       ;
 +7        SET TOTCURR=$GET(^TMP(TOTALS,$JOB,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3))
 +8        DO INCR^HLUCM001
 +9        SET ^TMP(TOTALS,$JOB,CATEGORY,TYPE,SORT,SUB1,SUB2,SUB3)=TOTCURR
 +10      ;
 +11      ; Totals level 2 for SUB...
 +12       SET TOTCURR=$GET(^TMP(TOTALS,$JOB,CATEGORY,TYPE,SORT,SUB1,SUB2))
 +13       DO INCR^HLUCM001
 +14       SET ^TMP(TOTALS,$JOB,CATEGORY,TYPE,SORT,SUB1,SUB2)=TOTCURR
 +15      ;
 +16      ; Totals level 1 for SUB...
 +17       SET TOTCURR=$GET(^TMP(TOTALS,$JOB,CATEGORY,TYPE,SORT,SUB1))
 +18       DO INCR^HLUCM001
 +19       SET ^TMP(TOTALS,$JOB,CATEGORY,TYPE,SORT,SUB1)=TOTCURR
 +20      ;
 +21      ; Total level TYPE/SORT...
 +22       SET TOTCURR=$GET(^TMP(TOTALS,$JOB,CATEGORY,TYPE,SORT))
 +23       DO INCR^HLUCM001
 +24       SET ^TMP(TOTALS,$JOB,CATEGORY,TYPE,SORT)=TOTCURR
 +25      ;
 +26      ; Total level TYPE
 +27       SET TOTCURR=$GET(^TMP(TOTALS,$JOB,CATEGORY,TYPE))
 +28       DO INCR^HLUCM001
 +29       SET ^TMP(TOTALS,$JOB,CATEGORY,TYPE)=TOTCURR
 +30      ;
 +31      ; Total level CATEGORY
 +32      ; [Don't subtotal here, for NMSP holds two different TYPEs, and
 +33      ; if totalled here, it would double count.]
 +34      ;
 +35       QUIT 
 +36      ;
LOAD772S(IEN772,HLNMSP) ; Load list of related 772s... [HL*1.6*91]
 +1       ;
 +2       ; Warning!!!  This call point will never load more than 20 entries...
 +3       ;             Any more than that, and probably an error condition
 +4       ;             exists.
 +5       ;
 +6        NEW ACKTO,CHILD,DATA,FAC,HL772,HLI,HLJ,HLK,HLN,HLPCKG,HLZZI,HOLDNMSP,I
 +7        NEW I772,I773,MSGID,NUM,PARENT,PCKG,PIEN,PROT,TOTNUM,VAL,X
 +8       ;
 +9        KILL HLNMSP
 +10      ;->
           if $GET(^HL(772,+$GET(IEN772),0))']""
               QUIT ""
 +11      ;
 +12      ;->
           SET DATA=$GET(^HL(772,+$GET(IEN772),0))
           if DATA']""
               QUIT ""
 +13      ;
 +14      ; Loop until no new entries found or more than 20 entries...
 +15       SET NUM=$$LOADEM^HLUCM050(+IEN772,.HLNMSP)
 +16      ;
 +17       QUIT NUM
 +18      ;
HOLDTOT(IEN) ; Accumulate...
 +1       ;->
           if $DATA(HOLDNMSP(IEN))!(TOTNUM>19)
               QUIT 
 +2        SET HOLDNMSP(IEN)=""
           SET TOTNUM=TOTNUM+1
 +3        QUIT 
 +4       ;
SETUP()   ; Perform checks, which can return error conditions, and
 +1       ; set up variables for $$LOOP.  This extrinsic function returns
 +2       ; "" if no errors, or the # errors found.  (Note that error
 +3       ; details placed in ERRINFO(ERROR-REASON)="")
 +4        NEW NOERR
 +5        SET NOERR=""
 +6       ; Set defaults for parameters, if not passed
           DO SETDEF
 +7       ; Find way NMSP and PROT parameters passed
           DO FINDWAY
 +8       ; Additional var sets based on parameters & "way"...
           DO SETMORE^HLUCM003
 +9       ; Check for errors...
           DO ERRCHK^HLUCM003
 +10      ; Clear out storage location...
           KILL ^TMP(TOTALS,$JOB)
 +11       QUIT NOERR
 +12      ;
SETDEF    ; Set various defaults...
 +1        IF '$DATA(PNMSP)
               SET PNMSP=1
 +2        IF '$DATA(IEN101)
               SET IEN101=1
 +3        IF $GET(TOTALS)']""
               SET TOTALS="HLTOTALS"
 +4        SET COND=$$UP^XLFSTR(COND)
 +5       ; Default to EITHER matches, count it...
           SET COND=$SELECT($GET(COND)="BOTH":COND,1:"EITHER")
 +6        QUIT 
 +7       ;
FINDWAY   ; How were NMSP and PROT passed?  By reference?  (If so, return 1)
 +1       ; Passed by reference?
 +2       ; 1=YES
           SET NMSPTYPE=$SELECT($GET(PNMSP)']""&($ORDER(PNMSP(""))]""):1,1:0)
 +3       ; 1=YES
           SET PROTYPE=$SELECT($GET(IEN101)']""&($ORDER(IEN101(""))]""):1,1:0)
 +4        QUIT 
 +5       ;
MSGID(MSGID) ; Search forward for MSA's to this MSGID...
 +1        NEW BIEN,CT,D,HOLD,I772,I773,MSA,X
 +2       ;
 +3        SET X=$ORDER(^HL(772,"C",MSGID,0))
           IF X
               SET HOLD(X)=""
 +4        SET X=$ORDER(^HLMA("C",MSGID,0))
           IF X
               SET X=+$GET(^HLMA(+X,0))
               IF X
                   SET HOLD(X)=""
 +5       ;
 +6        QUIT 
 +7       ;
ERRMOVE(IEN772) ; Move all associated data out of ^TMP's totaling arrays
 +1        NEW IEN772C,IEN772P
 +2       ;
 +3       ; Find parent message (because have to move ALL associated messages out)
 +4       ;->
           if $GET(^TMP($JOB,"HLUCM"))'="DEBUG GLOBAL"
               QUIT 
 +5        SET IEN772P=$ORDER(^TMP($JOB,"HLUCMSTORE","X",+IEN772,0))
 +6        IF IEN772P'>0
               SET IEN772P=IEN772
 +7       ;
 +8       ; Loop thru all associated messages in unit...
 +9        SET IEN772C=0
 +10       FOR 
               SET IEN772C=$ORDER(^TMP($JOB,"HLUCMSTORE","U",IEN772P,IEN772C))
               if 'IEN772C
                   QUIT 
               Begin DoDot:1
 +11               FOR SUB="C","E","O","X"
                       Begin DoDot:2
 +12                       MERGE ^TMP($JOB,"HLUCMSTORE","ERR",SUB,IEN772C)=^TMP($JOB,"HLUCMSTORE",SUB,IEN772C)
 +13                       KILL ^TMP($JOB,"HLUCMSTORE",SUB,IEN772C)
                       End DoDot:2
               End DoDot:1
 +14      ;
 +15      ; Maybe there is no X xref...
 +16       MERGE ^TMP($JOB,"HLUCMSTORE","ERR","E",+IEN772P)=^TMP($JOB,"HLUCMSTORE","E",+IEN772P)
 +17       KILL ^TMP($JOB,"HLUCMSTORE","E",+IEN772P)
 +18      ;
 +19      ; Finally, move the unit's data...
 +20       MERGE ^TMP($JOB,"HLUCMSTORE","ERR","U",IEN772P)=^TMP($JOB,"HLUCMSTORE","U",IEN772P)
 +21       KILL ^TMP($JOB,"HLUCMSTORE","U",IEN772P)
 +22      ;
 +23       QUIT 
 +24      ;
EOR       ;HLUCM009 - HL7/Capacity Mgt API-II ;2/25/03-08:50