HLUCM001 ;CIOFO-O/LJA - HL7/Capacity Mgt API (continued) ;05/01/2012
;;1.6;HEALTH LEVEL SEVEN;**79,88,103,158**;Oct 13, 1995;Build 14
;
ADDTMP ; Accumulate totals into ^TMP(TOTALS,$J,...)
; FAC,ORIGETM,ORIGSTM,TYPEHR,TYPEIO,TYPELR -- req
;
N CHAR,ERRFLAG,FAC,SEC,START,TOTCURR,TYPEHR,TYPEIO,TYPELR
;
S CHAR=$G(DATA("CHAR")),SEC=$G(DATA("DIFF")),FAC=$G(DATA("FAC"))
S TYPEHR=$G(DATA("HR")),TYPEIO=$G(DATA("IO")),TYPELR=$G(DATA("LR"))
;
S START=$$HR($G(DATA("START")))
;I START<ORIGSTM S START=ORIGSTM
;I START>ORIGETM S START=ORIGETM
;
; Back door way to total by day only. (Dropping HR).
I $D(^TMP($J,"HLUCMDT")) S START=START\1
;
; Is delta time greater than 30 minutes?
S ERRFLAG=0
I SEC>1799 D
. S X=TOTALS N TOTALS S TOTALS=X_"ERRTIME",ERRFLAG=1
. D ERRMOVE^HLUCM009(+IEN772) ; Move into ^TMP($J,"HLUCMSTORE","ERR")
; Store under TOTALS_ERRTIME
;
; Maybe, this IEN772 has already been ERRd by ERRMOVE^HLUCM009?
I $D(^TMP($J,"HLUCMSTORE","ERR","X",+IEN772)) D QUIT ;->
. D ERRMOVE^HLUCM009(+IEN772) ; Just to be sure
;
; Should this entry even be counted?
I (HLAPI="CMF"!(HLAPI="CM2F"))&(TYPELR'="R") QUIT ;->
;
; Accumulating and totaling here...
I TYPELR="R" D ACCUMFAC^HLUCM090
D ACCUMHR
D ACCUMSP
D ACCUMPR
D TOTALING
;
Q
;
TOTALING ; Grand totals
S TOTCURR=$G(^TMP(TOTALS,$J))
S $P(TOTCURR,U)=$P(TOTCURR,U)+DATA("CHAR")
I $G(HLUCMADD)'="DON'T ADD. COLLECT3~HLUCM003" D
. S $P(TOTCURR,U,2)=$P(TOTCURR,U,2)+1
S $P(TOTCURR,U,3)=$P(TOTCURR,U,3)+DATA("DIFF")
S $P(TOTCURR,U,4)=$P(TOTCURR,U,4)+1
S ^TMP(TOTALS,$J)=TOTCURR
Q
;
ACCUMHR ; Hour totaling
; DATA(),FAC,START,TYPEHR -- req
;
I HLAPI="CM"!(HLAPI="CM2") D ACCUMLAT^HLUCM009("HR","TM",TYPEHR,START,DATA("PCKG"),DATA("PROT"))
I HLAPI="CMF"!(HLAPI="CM2F") D ACCUMLAT^HLUCM009("HR","TM",TYPEHR,FAC,START,DATA("PCKG"),DATA("PROT"))
;
; Total level CATEGORY
S TOTCURR=$G(^TMP(TOTALS,$J,"HR"))
D INCR
S ^TMP(TOTALS,$J,"HR")=TOTCURR
;
QUIT
;
ACCUMSP ; Namespace totaling
; DATA(),FAC,TYPEIO,TYPELR -- req
;
I HLAPI="CM"!(HLAPI="CM2") D
. D ACCUMLAT^HLUCM009("NMSP","IO",TYPEIO,DATA("PCKG"),START,DATA("PROT"))
. D ACCUMLAT^HLUCM009("NMSP","LR",TYPELR,DATA("PCKG"),START,DATA("PROT"))
I HLAPI="CMF"!(HLAPI="CM2F") D
. D ACCUMLAT^HLUCM009("NMSP","IO",TYPEIO,FAC,DATA("PCKG"),START,DATA("PROT"))
. D ACCUMLAT^HLUCM009("NMSP","LR",TYPELR,FAC,DATA("PCKG"),START,DATA("PROT"))
;
; Total level CATEGORY
S TOTCURR=$G(^TMP(TOTALS,$J,"NMSP"))
D INCR
S ^TMP(TOTALS,$J,"NMSP")=TOTCURR
;
QUIT
;
ACCUMPR ; Protocol totaling...
; DATA(),FAC,START -- req
;
I HLAPI="CM"!(HLAPI="CM2") D ACCUMLAT^HLUCM009("PROT","PR","P",DATA("PROT"),DATA("PCKG"),START)
I HLAPI="CMF"!(HLAPI="CM2F") D ACCUMLAT^HLUCM009("PROT","PR","P",FAC,DATA("PROT"),DATA("PCKG"),START)
;
; Total level CATEGORY
S TOTCURR=$G(^TMP(TOTALS,$J,"PROT"))
D INCR
S ^TMP(TOTALS,$J,"PROT")=TOTCURR
;
QUIT
;
INCR ; Increment totals in TOTCURR...
; CHAR,SEC -- req
S $P(TOTCURR,U)=$P(TOTCURR,U)+CHAR ; Number characters
I $G(HLUCMADD)'="DON'T ADD. COLLECT3~HLUCM003" D
. S $P(TOTCURR,U,2)=$P(TOTCURR,U,2)+1
S $P(TOTCURR,U,3)=$P(TOTCURR,U,3)+SEC ; Processing seconds
S $P(TOTCURR,U,4)=$P(TOTCURR,U,4)+1
QUIT
;
HR(FMDT) ; Return FM DATE and HOUR only...
N HR
S FMDT=$G(FMDT)
I FMDT'?7N&(FMDT'?7N1"."1.N) QUIT "" ;->
S:FMDT'["." FMDT=FMDT_"."
S FMDT=$E(FMDT_"00",1,10) ; .00 thru .23 now...
S HR=+$P(FMDT,".",2)+1
S:HR<10 HR=0_HR S:HR>24 HR=24
QUIT (FMDT\1)_"."_HR
;
OKPAR101(PAR) ; PAR=IEN101...
N RET,VAL
;
I PAR=1!(PAR=2) QUIT PAR ;->
I PAR="0^9999999" QUIT PAR ;->
;
; Passed as 0^IEN or 0^PROTOCOL NAME...
S VAL=$P(PAR,U,2)
;
; Was IEN passed?
I VAL=+VAL D QUIT RET ;->
. S RET=""
. I $D(^ORD(101,+VAL,0)) S RET=PAR
. I '$D(^ORD(101,+VAL,0)) QUIT ;-> Leaving RET=""
;
; Name was passed... (Can be up to 63 characters long...)
; Find IEN for name...
S VAL=$$FIND101(PAR)
;
; If VAL=IEN, reset IEN101 to 0^IEN format...
I VAL>0 QUIT "0^"_+VAL ;->
;
QUIT ""
;
TYPELR(IEN772,FACNM) ; Is this Local or Remote or Unknown?
; SITENM -- req
N D772,I773,IEN,IEN870,IO,MIEN,NM,TXT,TYPE,X
;
; If SITENM=FACNM, then it isn't remote...
I $G(SITENM)]"",$G(FACNM)]"",SITENM=FACNM QUIT "L" ;->
;
S D772=$G(^HL(772,+IEN772,0))
;
; Mailman check...
S MIEN=$P(D772,U,5) ; get Mailman IEN...
I MIEN S X=$$MAILTYPE^HLUCM009(MIEN) QUIT:X="R" $$SLR(IEN772,"R") ;-> Mailman, and remote...
;
; Additional mail check...
I $$MAIL870^HLUCM090(IEN772)="R" QUIT $$SLR(IEN772,"R") ;->
;
; Institution check...
I $$INST870^HLUCM090(+IEN772,+$P($$SITE^VASITE,U,3))="R" QUIT $$SLR(IEN772,"R") ;->
;
; MSH segment in 773 check...
S TYPE="L",I773=0
F S I773=$O(^HLMA("B",IEN772,I773)) Q:'I773!(TYPE'="L") D
. N DIV,P4,P6
. S TXT="",MIEN=0
. F S MIEN=$O(^HLMA(+I773,"MSH",MIEN)) Q:MIEN'>0 D
. . S TXT=TXT_$G(^HLMA(+I773,"MSH",+MIEN,0))
. QUIT:TXT']"" ;->
. S X=$$SITESMSH^HLUCM009(TXT),P4=$P(X,U),P6=$P(X,U,2)
. S:P4'=P6 TYPE="R"
;
; Was anything found?
QUIT:TYPE'="L" $$SLR(IEN772,TYPE) ;->
;
; Logical links check...
S IEN870=$$IEN870^HLUCM009(+IEN772) I IEN870 D
. N DATA,MGIEN
. S DATA=$G(^HLCS(870,+IEN870,0))
. QUIT:$P(DATA,U,3)'=1 ;-> Not MAIL...
. S MGIEN=$P($G(^HLCS(870,+IEN870,100)),U) QUIT:MGIEN'>0 ;->
. ; If a MAIL type link and there is an associated mail group,
. ; it is almost always REMOTE. Enough so, that "R" will be assumed.
. ; QUIT:$O(^XMB(3.8,+MGIEN,6,0))'>0 ;-> No remote groups
. S TYPE="R"
. ; Rare to hit this point.
;
QUIT $$SLR(IEN772,TYPE)
;
SLR(IEN772,LR) ; Store the L/R type for use for FACILITY sorting
N FAC,HLDATA,PARENT,TYPE,X
Q LR
;
PREPARE() ; Called by $$CM & $$CM2 and other APIs...
;
S ORIGSTM=$G(START),ORIGETM=$G(END)
S SITENM=$P($$SITE^VASITE,U,2)
;
; Summarize by DAY instead of hour?
I ORIGSTM?7N,ORIGETM']"" D
. S ^TMP($J,"HLUCMDT")=""
. S ORIGETM=ORIGSTM_".24"
;
D ZEROUP
;
; Miscellaneous KILLs...
D KILLS^HLUCM009("START")
;
; Build namespace xref
D NMSPXRF^HLUCM009
;
; This is where results are returned to caller...
KILL ERRINFO
;
; Perform all setup chores. If errors found, they will be placed
; in ERRINFO(ERROR-REASON)="" array
QUIT:$$SETUP^HLUCM009 "" ;-> Some errors occurred...
;
Q 1
;
ZEROUP ; If didn't add 0^...
I $G(IEN101)]"",IEN101'?1N,IEN101'?1"0^".E S IEN101="0^"_IEN101
I $G(PNMSP)]"",PNMSP'?1N,PNMSP'?1"0^".E S PNMSP="0^"_PNMSP
Q
;
FIND101(VAL) ; No checking for upp/lowercase. Must be passed right!
; VAL = Protocol name...
N FIEN,IEN,LNM,PNM
;
S VAL=$P(VAL,"0^",2)
;
; Passed as IEN?
I VAL=+VAL,$D(^ORD(101,+VAL,0)) QUIT +VAL ;->
;
; Passed as NAME?
S FIEN=0
S LNM=$E(VAL,1,$S($L(VAL)>30:29,1:$L(VAL)-1))
F S LNM=$O(^ORD(101,"B",LNM)) Q:LNM]VAL!(LNM']"")!(FIEN) D
. S IEN=0
. F S IEN=$O(^ORD(101,"B",LNM,IEN)) Q:IEN'>0!(FIEN) D
. . QUIT:$P($G(^ORD(101,+IEN,0)),U)'=VAL ;->
. . S FIEN=+IEN
QUIT $S(FIEN:FIEN,1:"")
;
REFPROT(PROT) ; If passed by reference, is PROT in array? 0=Don't count, 2=Count
; PROTYPE -- req
N X
I PROTYPE'=1 QUIT 1 ;-> Not passed by reference...
S X=$P(PROT,"~") I X]"" I $D(IEN101(X)) QUIT 1 ;-> found by name in array
S X=$P(PROT,"~",2) I X]"" I $D(IEN101(+X)) QUIT 1 ;-> found by IEN in array
QUIT ""
;
REFPCKG(PCKG) ; If passed by reference, is PCKG in array? 0=Don't count,1=OK to count
; NMSPTYPE -- req
I NMSPTYPE'=1 QUIT 1 ;-> Not passed by reference...
I PCKG]"" I $D(PNMSP(PCKG)) QUIT 1 ;-> found in array
QUIT ""
;
EOR ; HLUCM001 - HL7/Capacity Mgt API (continued) ;2/27/01 10:15
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLUCM001 7797 printed Dec 13, 2024@02:00:11 Page 2
HLUCM001 ;CIOFO-O/LJA - HL7/Capacity Mgt API (continued) ;05/01/2012
+1 ;;1.6;HEALTH LEVEL SEVEN;**79,88,103,158**;Oct 13, 1995;Build 14
+2 ;
ADDTMP ; Accumulate totals into ^TMP(TOTALS,$J,...)
+1 ; FAC,ORIGETM,ORIGSTM,TYPEHR,TYPEIO,TYPELR -- req
+2 ;
+3 NEW CHAR,ERRFLAG,FAC,SEC,START,TOTCURR,TYPEHR,TYPEIO,TYPELR
+4 ;
+5 SET CHAR=$GET(DATA("CHAR"))
SET SEC=$GET(DATA("DIFF"))
SET FAC=$GET(DATA("FAC"))
+6 SET TYPEHR=$GET(DATA("HR"))
SET TYPEIO=$GET(DATA("IO"))
SET TYPELR=$GET(DATA("LR"))
+7 ;
+8 SET START=$$HR($GET(DATA("START")))
+9 ;I START<ORIGSTM S START=ORIGSTM
+10 ;I START>ORIGETM S START=ORIGETM
+11 ;
+12 ; Back door way to total by day only. (Dropping HR).
+13 IF $DATA(^TMP($JOB,"HLUCMDT"))
SET START=START\1
+14 ;
+15 ; Is delta time greater than 30 minutes?
+16 SET ERRFLAG=0
+17 IF SEC>1799
Begin DoDot:1
+18 SET X=TOTALS
NEW TOTALS
SET TOTALS=X_"ERRTIME"
SET ERRFLAG=1
+19 ; Move into ^TMP($J,"HLUCMSTORE","ERR")
DO ERRMOVE^HLUCM009(+IEN772)
End DoDot:1
+20 ; Store under TOTALS_ERRTIME
+21 ;
+22 ; Maybe, this IEN772 has already been ERRd by ERRMOVE^HLUCM009?
+23 ;->
IF $DATA(^TMP($JOB,"HLUCMSTORE","ERR","X",+IEN772))
Begin DoDot:1
+24 ; Just to be sure
DO ERRMOVE^HLUCM009(+IEN772)
End DoDot:1
QUIT
+25 ;
+26 ; Should this entry even be counted?
+27 ;->
IF (HLAPI="CMF"!(HLAPI="CM2F"))&(TYPELR'="R")
QUIT
+28 ;
+29 ; Accumulating and totaling here...
+30 IF TYPELR="R"
DO ACCUMFAC^HLUCM090
+31 DO ACCUMHR
+32 DO ACCUMSP
+33 DO ACCUMPR
+34 DO TOTALING
+35 ;
+36 QUIT
+37 ;
TOTALING ; Grand totals
+1 SET TOTCURR=$GET(^TMP(TOTALS,$JOB))
+2 SET $PIECE(TOTCURR,U)=$PIECE(TOTCURR,U)+DATA("CHAR")
+3 IF $GET(HLUCMADD)'="DON'T ADD. COLLECT3~HLUCM003"
Begin DoDot:1
+4 SET $PIECE(TOTCURR,U,2)=$PIECE(TOTCURR,U,2)+1
End DoDot:1
+5 SET $PIECE(TOTCURR,U,3)=$PIECE(TOTCURR,U,3)+DATA("DIFF")
+6 SET $PIECE(TOTCURR,U,4)=$PIECE(TOTCURR,U,4)+1
+7 SET ^TMP(TOTALS,$JOB)=TOTCURR
+8 QUIT
+9 ;
ACCUMHR ; Hour totaling
+1 ; DATA(),FAC,START,TYPEHR -- req
+2 ;
+3 IF HLAPI="CM"!(HLAPI="CM2")
DO ACCUMLAT^HLUCM009("HR","TM",TYPEHR,START,DATA("PCKG"),DATA("PROT"))
+4 IF HLAPI="CMF"!(HLAPI="CM2F")
DO ACCUMLAT^HLUCM009("HR","TM",TYPEHR,FAC,START,DATA("PCKG"),DATA("PROT"))
+5 ;
+6 ; Total level CATEGORY
+7 SET TOTCURR=$GET(^TMP(TOTALS,$JOB,"HR"))
+8 DO INCR
+9 SET ^TMP(TOTALS,$JOB,"HR")=TOTCURR
+10 ;
+11 QUIT
+12 ;
ACCUMSP ; Namespace totaling
+1 ; DATA(),FAC,TYPEIO,TYPELR -- req
+2 ;
+3 IF HLAPI="CM"!(HLAPI="CM2")
Begin DoDot:1
+4 DO ACCUMLAT^HLUCM009("NMSP","IO",TYPEIO,DATA("PCKG"),START,DATA("PROT"))
+5 DO ACCUMLAT^HLUCM009("NMSP","LR",TYPELR,DATA("PCKG"),START,DATA("PROT"))
End DoDot:1
+6 IF HLAPI="CMF"!(HLAPI="CM2F")
Begin DoDot:1
+7 DO ACCUMLAT^HLUCM009("NMSP","IO",TYPEIO,FAC,DATA("PCKG"),START,DATA("PROT"))
+8 DO ACCUMLAT^HLUCM009("NMSP","LR",TYPELR,FAC,DATA("PCKG"),START,DATA("PROT"))
End DoDot:1
+9 ;
+10 ; Total level CATEGORY
+11 SET TOTCURR=$GET(^TMP(TOTALS,$JOB,"NMSP"))
+12 DO INCR
+13 SET ^TMP(TOTALS,$JOB,"NMSP")=TOTCURR
+14 ;
+15 QUIT
+16 ;
ACCUMPR ; Protocol totaling...
+1 ; DATA(),FAC,START -- req
+2 ;
+3 IF HLAPI="CM"!(HLAPI="CM2")
DO ACCUMLAT^HLUCM009("PROT","PR","P",DATA("PROT"),DATA("PCKG"),START)
+4 IF HLAPI="CMF"!(HLAPI="CM2F")
DO ACCUMLAT^HLUCM009("PROT","PR","P",FAC,DATA("PROT"),DATA("PCKG"),START)
+5 ;
+6 ; Total level CATEGORY
+7 SET TOTCURR=$GET(^TMP(TOTALS,$JOB,"PROT"))
+8 DO INCR
+9 SET ^TMP(TOTALS,$JOB,"PROT")=TOTCURR
+10 ;
+11 QUIT
+12 ;
INCR ; Increment totals in TOTCURR...
+1 ; CHAR,SEC -- req
+2 ; Number characters
SET $PIECE(TOTCURR,U)=$PIECE(TOTCURR,U)+CHAR
+3 IF $GET(HLUCMADD)'="DON'T ADD. COLLECT3~HLUCM003"
Begin DoDot:1
+4 SET $PIECE(TOTCURR,U,2)=$PIECE(TOTCURR,U,2)+1
End DoDot:1
+5 ; Processing seconds
SET $PIECE(TOTCURR,U,3)=$PIECE(TOTCURR,U,3)+SEC
+6 SET $PIECE(TOTCURR,U,4)=$PIECE(TOTCURR,U,4)+1
+7 QUIT
+8 ;
HR(FMDT) ; Return FM DATE and HOUR only...
+1 NEW HR
+2 SET FMDT=$GET(FMDT)
+3 ;->
IF FMDT'?7N&(FMDT'?7N1"."1.N)
QUIT ""
+4 if FMDT'["."
SET FMDT=FMDT_"."
+5 ; .00 thru .23 now...
SET FMDT=$EXTRACT(FMDT_"00",1,10)
+6 SET HR=+$PIECE(FMDT,".",2)+1
+7 if HR<10
SET HR=0_HR
if HR>24
SET HR=24
+8 QUIT (FMDT\1)_"."_HR
+9 ;
OKPAR101(PAR) ; PAR=IEN101...
+1 NEW RET,VAL
+2 ;
+3 ;->
IF PAR=1!(PAR=2)
QUIT PAR
+4 ;->
IF PAR="0^9999999"
QUIT PAR
+5 ;
+6 ; Passed as 0^IEN or 0^PROTOCOL NAME...
+7 SET VAL=$PIECE(PAR,U,2)
+8 ;
+9 ; Was IEN passed?
+10 ;->
IF VAL=+VAL
Begin DoDot:1
+11 SET RET=""
+12 IF $DATA(^ORD(101,+VAL,0))
SET RET=PAR
+13 ;-> Leaving RET=""
IF '$DATA(^ORD(101,+VAL,0))
QUIT
End DoDot:1
QUIT RET
+14 ;
+15 ; Name was passed... (Can be up to 63 characters long...)
+16 ; Find IEN for name...
+17 SET VAL=$$FIND101(PAR)
+18 ;
+19 ; If VAL=IEN, reset IEN101 to 0^IEN format...
+20 ;->
IF VAL>0
QUIT "0^"_+VAL
+21 ;
+22 QUIT ""
+23 ;
TYPELR(IEN772,FACNM) ; Is this Local or Remote or Unknown?
+1 ; SITENM -- req
+2 NEW D772,I773,IEN,IEN870,IO,MIEN,NM,TXT,TYPE,X
+3 ;
+4 ; If SITENM=FACNM, then it isn't remote...
+5 ;->
IF $GET(SITENM)]""
IF $GET(FACNM)]""
IF SITENM=FACNM
QUIT "L"
+6 ;
+7 SET D772=$GET(^HL(772,+IEN772,0))
+8 ;
+9 ; Mailman check...
+10 ; get Mailman IEN...
SET MIEN=$PIECE(D772,U,5)
+11 ;-> Mailman, and remote...
IF MIEN
SET X=$$MAILTYPE^HLUCM009(MIEN)
if X="R"
QUIT $$SLR(IEN772,"R")
+12 ;
+13 ; Additional mail check...
+14 ;->
IF $$MAIL870^HLUCM090(IEN772)="R"
QUIT $$SLR(IEN772,"R")
+15 ;
+16 ; Institution check...
+17 ;->
IF $$INST870^HLUCM090(+IEN772,+$PIECE($$SITE^VASITE,U,3))="R"
QUIT $$SLR(IEN772,"R")
+18 ;
+19 ; MSH segment in 773 check...
+20 SET TYPE="L"
SET I773=0
+21 FOR
SET I773=$ORDER(^HLMA("B",IEN772,I773))
if 'I773!(TYPE'="L")
QUIT
Begin DoDot:1
+22 NEW DIV,P4,P6
+23 SET TXT=""
SET MIEN=0
+24 FOR
SET MIEN=$ORDER(^HLMA(+I773,"MSH",MIEN))
if MIEN'>0
QUIT
Begin DoDot:2
+25 SET TXT=TXT_$GET(^HLMA(+I773,"MSH",+MIEN,0))
End DoDot:2
+26 ;->
if TXT']""
QUIT
+27 SET X=$$SITESMSH^HLUCM009(TXT)
SET P4=$PIECE(X,U)
SET P6=$PIECE(X,U,2)
+28 if P4'=P6
SET TYPE="R"
End DoDot:1
+29 ;
+30 ; Was anything found?
+31 ;->
if TYPE'="L"
QUIT $$SLR(IEN772,TYPE)
+32 ;
+33 ; Logical links check...
+34 SET IEN870=$$IEN870^HLUCM009(+IEN772)
IF IEN870
Begin DoDot:1
+35 NEW DATA,MGIEN
+36 SET DATA=$GET(^HLCS(870,+IEN870,0))
+37 ;-> Not MAIL...
if $PIECE(DATA,U,3)'=1
QUIT
+38 ;->
SET MGIEN=$PIECE($GET(^HLCS(870,+IEN870,100)),U)
if MGIEN'>0
QUIT
+39 ; If a MAIL type link and there is an associated mail group,
+40 ; it is almost always REMOTE. Enough so, that "R" will be assumed.
+41 ; QUIT:$O(^XMB(3.8,+MGIEN,6,0))'>0 ;-> No remote groups
+42 SET TYPE="R"
+43 ; Rare to hit this point.
End DoDot:1
+44 ;
+45 QUIT $$SLR(IEN772,TYPE)
+46 ;
SLR(IEN772,LR) ; Store the L/R type for use for FACILITY sorting
+1 NEW FAC,HLDATA,PARENT,TYPE,X
+2 QUIT LR
+3 ;
PREPARE() ; Called by $$CM & $$CM2 and other APIs...
+1 ;
+2 SET ORIGSTM=$GET(START)
SET ORIGETM=$GET(END)
+3 SET SITENM=$PIECE($$SITE^VASITE,U,2)
+4 ;
+5 ; Summarize by DAY instead of hour?
+6 IF ORIGSTM?7N
IF ORIGETM']""
Begin DoDot:1
+7 SET ^TMP($JOB,"HLUCMDT")=""
+8 SET ORIGETM=ORIGSTM_".24"
End DoDot:1
+9 ;
+10 DO ZEROUP
+11 ;
+12 ; Miscellaneous KILLs...
+13 DO KILLS^HLUCM009("START")
+14 ;
+15 ; Build namespace xref
+16 DO NMSPXRF^HLUCM009
+17 ;
+18 ; This is where results are returned to caller...
+19 KILL ERRINFO
+20 ;
+21 ; Perform all setup chores. If errors found, they will be placed
+22 ; in ERRINFO(ERROR-REASON)="" array
+23 ;-> Some errors occurred...
if $$SETUP^HLUCM009
QUIT ""
+24 ;
+25 QUIT 1
+26 ;
ZEROUP ; If didn't add 0^...
+1 IF $GET(IEN101)]""
IF IEN101'?1N
IF IEN101'?1"0^".E
SET IEN101="0^"_IEN101
+2 IF $GET(PNMSP)]""
IF PNMSP'?1N
IF PNMSP'?1"0^".E
SET PNMSP="0^"_PNMSP
+3 QUIT
+4 ;
FIND101(VAL) ; No checking for upp/lowercase. Must be passed right!
+1 ; VAL = Protocol name...
+2 NEW FIEN,IEN,LNM,PNM
+3 ;
+4 SET VAL=$PIECE(VAL,"0^",2)
+5 ;
+6 ; Passed as IEN?
+7 ;->
IF VAL=+VAL
IF $DATA(^ORD(101,+VAL,0))
QUIT +VAL
+8 ;
+9 ; Passed as NAME?
+10 SET FIEN=0
+11 SET LNM=$EXTRACT(VAL,1,$SELECT($LENGTH(VAL)>30:29,1:$LENGTH(VAL)-1))
+12 FOR
SET LNM=$ORDER(^ORD(101,"B",LNM))
if LNM]VAL!(LNM']"")!(FIEN)
QUIT
Begin DoDot:1
+13 SET IEN=0
+14 FOR
SET IEN=$ORDER(^ORD(101,"B",LNM,IEN))
if IEN'>0!(FIEN)
QUIT
Begin DoDot:2
+15 ;->
if $PIECE($GET(^ORD(101,+IEN,0)),U)'=VAL
QUIT
+16 SET FIEN=+IEN
End DoDot:2
End DoDot:1
+17 QUIT $SELECT(FIEN:FIEN,1:"")
+18 ;
REFPROT(PROT) ; If passed by reference, is PROT in array? 0=Don't count, 2=Count
+1 ; PROTYPE -- req
+2 NEW X
+3 ;-> Not passed by reference...
IF PROTYPE'=1
QUIT 1
+4 ;-> found by name in array
SET X=$PIECE(PROT,"~")
IF X]""
IF $DATA(IEN101(X))
QUIT 1
+5 ;-> found by IEN in array
SET X=$PIECE(PROT,"~",2)
IF X]""
IF $DATA(IEN101(+X))
QUIT 1
+6 QUIT ""
+7 ;
REFPCKG(PCKG) ; If passed by reference, is PCKG in array? 0=Don't count,1=OK to count
+1 ; NMSPTYPE -- req
+2 ;-> Not passed by reference...
IF NMSPTYPE'=1
QUIT 1
+3 ;-> found in array
IF PCKG]""
IF $DATA(PNMSP(PCKG))
QUIT 1
+4 QUIT ""
+5 ;
EOR ; HLUCM001 - HL7/Capacity Mgt API (continued) ;2/27/01 10:15
