Routine: HLUCM001

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

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

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

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

HLUCM001.m