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 Oct 16, 2024@18:01:02 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