- 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 Feb 18, 2025@23:26:39 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