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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLUCM001   7797     printed  Feb 18, 2025@23:26:35                                                                                                                                                                                                    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

HLUCM001.m