269 lines
8.7 KiB
Mathematica
269 lines
8.7 KiB
Mathematica
HLUCM002 ;CIOFO-O/LJA - HL7/Capacity Mgt API ;2/27/01 10:15
|
|
;;1.6;HEALTH LEVEL SEVEN;**79,88,103**;Oct 13, 1995
|
|
;
|
|
PRINTREG ; Print data in ^TMP(SUB,...) to screen
|
|
; SUB,JOBN -- req
|
|
N DEB,GBL,IOINHI,IOINORM,JOBN,SUB,TOT,WAY,X,XTMPGBL
|
|
;
|
|
S X="IOINHI;IOINORM" D ENDR^%ZISS
|
|
;
|
|
W @IOF,$$CJ^XLFSTR("Print Totals Report & Debug Data to Screen",IOM)
|
|
W !,$$REPEAT^XLFSTR("=",IOM)
|
|
;
|
|
S XTMPGBL=""
|
|
;
|
|
; What is the SUB for the Totals Report...
|
|
S SUB=$$SUB
|
|
I SUB']"" W !!,"OK! No ^TMP(TOTALS,$J) totals report will be printed..."
|
|
I SUB]"" D PTOT
|
|
;
|
|
; Debug data...
|
|
I '$D(^TMP($J,"HLUCMSTORE")) D
|
|
. W !!,"No ^TMP($J,""HLUCMSTORE"") debug data exists..."
|
|
I $D(^TMP($J,"HLUCMSTORE")) D PSTORE
|
|
;
|
|
I SUB']"",'$D(^TMP($J,"HLUCMSTORE")) D QUIT ;->
|
|
. S X=$$BTE^HLCSMON("Press RETURN to exit... ",1)
|
|
;
|
|
QUIT:$$BTE^HLCSMON("Press RETURN to restart, or '^' to exit... ",1) ;->
|
|
;
|
|
G PRINTREG ;->
|
|
;
|
|
PSTORE ;
|
|
W !!,$$CJ^XLFSTR("----------- "_IOINHI_"Debug Data from ^TMP($J,""HLUCMSTORE"")"_IOINORM_" -----------",IOM)
|
|
R !!,"Print raw DEBUG DATA (Y/N): Yes// ",X:999 S:X="" X="Y" S DEB=$$UP^XLFSTR($E(X_" ")) Q:'$T!(DEB[U) ;->
|
|
I DEB="Y" D PRINTDBG^HLUCM090
|
|
;
|
|
R !!,"Print filtered DEBUG DATA (Y/N): Yes// ",X:999 S:X="" X="Y" S DEB=$$UP^XLFSTR($E(X_" ")) Q:'$T!(DEB[U) ;->
|
|
I DEB="Y" D LOOPU^HLUCM004
|
|
Q
|
|
;
|
|
PTOT ;
|
|
W !!,"You will be allowed to print report totals (from ^TMP(TOTALS,$J), and/or you"
|
|
W !,"may print the debug data (in ^TMP($J,""HLUCMSTORE"")."
|
|
W !!,$$CJ^XLFSTR("------------ "_IOINHI_"Report Totals from ^TMP("""_SUB_""",$J)"_IOINORM_" ------------",IOM)
|
|
R !!,"Print REPORT TOTALS (Y/N): Yes// ",X:999 S:X="" X="Y" S TOT=$$UP^XLFSTR($E(X_" ")) Q:'$T!(TOT[U) ;->
|
|
I TOT="Y" D
|
|
. S SUB="TOT",JOBN=$J
|
|
. I '$D(^TMP(SUB,JOBN)) S SUB="KMPDH"
|
|
. R !,"Include subtotals (Y/N): NO// ",WAY:999 QUIT:'$T!(WAY[U) ;->
|
|
. S:WAY']"" WAY="N"
|
|
. S WAY=$$UP^XLFSTR($E(WAY_" ")),WAY=$S(WAY="N":0,1:1)
|
|
. S X=$$XTMPGBL^HLUCM004(0) I X]"" S (GBL,XTMPGBL)=X W !!,"Printing from ",XTMPGBL,"..."
|
|
. D PRINT1
|
|
Q
|
|
;
|
|
SUB() ; What subscript holds the ^TMP(SUB,$J) data?
|
|
N SUB
|
|
I $D(^TMP("KMPDH",$J)) QUIT "KMPDH" ;->
|
|
I $D(^TMP("TOT",$J)) QUIT "TOT" ;->
|
|
R !!,"Enter subscript holding the ^TMP(TOTALS,$J) data: ",SUB:999 Q:SUB[U!(SUB']"") "" ;->
|
|
Q SUB
|
|
;
|
|
PRINT(SUB,JOBN,WAY) ; Print data in ^TMP(SUB,...) to screen
|
|
; WAY -- 0 = No totals
|
|
; 1 = Totals for every section
|
|
N L1,L2,L3
|
|
;
|
|
S WAY=$S($G(WAY)'>0:0,$G(WAY)=1:1,1:0)
|
|
;
|
|
S:$G(JOBN)'>0 JOBN=$J
|
|
I $G(SUB)']"" D QUIT ;->
|
|
. W !!,"You must pass in the initial subscript and $JOB number..."
|
|
. W !
|
|
PRINT1 D PRINT1^HLUCM090
|
|
;
|
|
S GBL=$NA(^TMP($J,"HLUCMSTORE","T"))
|
|
S L1=0 F L2="CCX","CXC","CXX","XCC","XCX","XXC","XXX" I $D(@GBL@(L2)) S L1=1
|
|
QUIT:'L1 ;->
|
|
;
|
|
W !!,"Some entries were not included in the totals. There are 3 possible reasons"
|
|
W !,"for entries being excluded: (1) The beginning time of a message or unit is"
|
|
W !,"before the report's start time, (2) The number of seconds to transmit the"
|
|
W !,"message is over 1799 seconds, and (3) The protocol or namespace doesn't meet"
|
|
W !,"the search criteria."
|
|
W !!,"Failure Reason",?30,"#Characters",?42,"#Msg/Units",?54,"#Seconds"
|
|
W !,$$REPEAT^XLFSTR("=",IOM)
|
|
;
|
|
F LAST="CCX","CXC","CXX","XCC","XCX","XXC","XXX" I $G(@GBL@(LAST))]"" Q
|
|
;
|
|
S TYP="XXX",DATA=$G(@GBL@(TYP)) I DATA]"" D
|
|
. D SHOW("Beginning time too early",DATA)
|
|
. D SHOW("Excessive xmit time")
|
|
. D SHOW("Prot/Nmsp mismatch","",1)
|
|
S TYP="XXC",DATA=$G(@GBL@("XXC")) I DATA]"" D
|
|
. D SHOW("Beginning time too early",DATA)
|
|
. D SHOW("Excessive xmit time","",1)
|
|
S TYP="XCX",DATA=$G(@GBL@("XCX")) I DATA]"" D
|
|
. D SHOW("Beginning time too early",DATA)
|
|
. D SHOW("Prot/Nmsp mismatch","",1)
|
|
S TYP="XCC",DATA=$G(@GBL@("XCC")) I DATA]"" D
|
|
. D SHOW("Beginning time too early",DATA,1)
|
|
S TYP="CXX",DATA=$G(@GBL@("CXX")) I DATA]"" D
|
|
. D SHOW("Excessive xmit time",DATA)
|
|
. D SHOW("Prot/Nmsp mismatch","",1)
|
|
S TYP="CXC",DATA=$G(@GBL@("CXC")) I DATA]"" D
|
|
. D SHOW("Excessive xmit time",DATA,1)
|
|
S TYP="CCX",DATA=$G(@GBL@("CCX")) I DATA]"" D
|
|
. D SHOW("Prot/Nmsp mismatch",DATA,1)
|
|
I L1!L2!L3 W !,$$REPEAT^XLFSTR("=",IOM),!,"Totals:",?30,$J(L1,7),?42,$J(L2,7),?54,$J(L3,7)
|
|
;
|
|
Q
|
|
;
|
|
SHOW(REA,DATA,LINE) ;
|
|
; LAST,TYP -- req
|
|
S DATA=$G(DATA),LINE=$G(LINE)
|
|
W !,REA
|
|
I $G(DATA)]"" W ?30,$J($P(DATA,U),7),?42,$J($P(DATA,U,2),7),?54,$J($P(DATA,U,3),7)
|
|
I $G(LINE),TYP'=LAST W !,$$REPEAT^XLFSTR("-",IOM)
|
|
S L1=$G(L1)+$P(DATA,U),L2=$G(L2)+$P(DATA,U,2),L3=$G(L3)+$P(DATA,U,3)
|
|
QUIT
|
|
;
|
|
ADD(TL) ; Add to TOT...
|
|
S $P(TOT,U)=$P(TOT,U)+$P(TL,U)
|
|
S $P(TOT,U,2)=$P(TOT,U,2)+$P(TL,U,2)
|
|
S $P(TOT,U,3)=$P(TOT,U,3)+$P(TL,U,3)
|
|
Q
|
|
;
|
|
OKPAR(PAR) ; Is namespace or protocol OK?
|
|
S PAR=$G(PAR)
|
|
I PAR=1!(PAR=2) QUIT 1 ;->
|
|
I $$OK0CALL(PAR) QUIT 1 ;->
|
|
QUIT ""
|
|
;
|
|
OK0CALL(PAR) ; Correct 0^IEN or 0^NAME call format?
|
|
I $E(PAR,1,2)="0^"&($E(PAR,3)]"") QUIT 1 ;->
|
|
QUIT ""
|
|
;
|
|
TYPETMO(IEN772) ; Is this TCP, Mail (via TCP), or Other?
|
|
N D772,I773,MIEN
|
|
;
|
|
; RELATED MAILMAN MESSAGE field (0;5) in 772...
|
|
S D772=$G(^HL(772,+IEN772,0)) ; Get node
|
|
S MIEN=$P(D772,U,5) ; get Mailman IEN from field...
|
|
I MIEN QUIT "M" ;-> Mailman via TCP
|
|
;
|
|
; There are rare instances when RELATED MAILMAN MESSAGE field is
|
|
; not filled in, but the LLP TYPE in 870 is Mailman. So, the next
|
|
; check is needed...
|
|
;
|
|
; Get related 870 and check it's LLP TYPE...
|
|
I $P($G(^HLCS(870,+$$IEN870^HLUCM009(+IEN772),0)),U,3)=1 QUIT "M" ;->
|
|
;
|
|
; OK. Let's give up on proving this 772 entry a Mailman entry.
|
|
; But, is it TCP?
|
|
;
|
|
; Check if TCP by 773 link...
|
|
S I773=$O(^HLMA("B",+IEN772,0))
|
|
I I773>0 QUIT "T" ;->
|
|
;
|
|
QUIT "U" ; Other...
|
|
;
|
|
TYPEIO(IEN772) ; Is this Input or Output or Unknown?
|
|
N D772,HLIO
|
|
S D772=$G(^HL(772,+IEN772,0))
|
|
S HLIO=$E($P(D772,U,4)_" ")
|
|
QUIT $S("IO"[HLIO:HLIO,1:"U")
|
|
;
|
|
PROTNMSP(IEN772) ; Return PROT~NMSP value to store in ^TMP.
|
|
; COND,IEN101,PNMSP -- req
|
|
N CT,FAIL,PCKG,CTPROT,PCKG,PROT
|
|
;
|
|
S IEN101=$G(IEN101),PNMSP=$G(PNMSP)
|
|
;
|
|
; ======================== PROTOCOL ============================
|
|
; Get actual protocol in IEN772 if not supposed to "lump"...
|
|
S PROT=$S(IEN101'=2:$$GETPROT^HLUCM050(+IEN772),1:"ZZZ")
|
|
;
|
|
; Don't lose count if supposed to check everything...
|
|
I IEN101=1!(IEN101=2) D
|
|
. I PROT']"" S PROT="ZZZ" QUIT ;->
|
|
. I IEN101=2 S PROT="ZZZ"
|
|
;
|
|
; Is the protocol countable? (Must also check namespace)
|
|
S CTPROT=$$CTPROT^HLUCM003(PROT)
|
|
;
|
|
; ======================== NAMESPACE ============================
|
|
; Set package here and now...
|
|
S PCKG=$S(PNMSP'=2:$$GETNMSP^HLUCM050(+IEN772),1:"ZZZ")
|
|
;
|
|
I PNMSP=1!(PNMSP=2) D
|
|
. I PCKG']"" S PCKG="ZZZ" QUIT ;->
|
|
. I PNMSP=2 S PCKG="ZZZ"
|
|
;
|
|
S CTPCKG=$$CTPCKG^HLUCM003(PCKG)
|
|
;
|
|
;
|
|
; Set up what should be returned...
|
|
S PROT=$S(PROT=2:"ZZZ",1:PROT),PCKG=$S(PCKG=2:"ZZZ",1:PCKG)
|
|
; If MIXED make sure the ALL side of things is set to something
|
|
; so the ALL side doesn't squelch a SPECIFIC match...
|
|
I $$MIXED D
|
|
. I $G(PNMSP)=1!($G(PNMSP)=2) D
|
|
. . QUIT:PROT]"" ;->
|
|
. . QUIT:'CTPROT ;-> Not to be counted anyway...
|
|
. . S PROT="ZZZ~0"
|
|
. I $G(IEN101)=1!($G(IEN101)=2) D
|
|
. . QUIT:PCKG]"" ;->
|
|
. . QUIT:'CTPCKG ;-> Not to be counted anyway...
|
|
. . S PCKG="ZZZ"
|
|
I '$$MIXED,COND="EITHER" D
|
|
. QUIT:$$ALL($G(PNMSP),$G(IEN101)) ;-> All 1s or 2s...
|
|
. I NMSPTYPE'=1 D ; Asked specifically...
|
|
. . QUIT:PROT]"" ;->
|
|
. . S PROT="ZZZ~0"
|
|
. I PROTYPE'=1 D ; Asked specifically...
|
|
. . QUIT:PCKG]"" ;->
|
|
. . S PCKG="ZZZ"
|
|
;
|
|
; If neither should be counted, don't...
|
|
I 'CTPROT&('CTPCKG) QUIT U ;->
|
|
;
|
|
; Either namespace or protocol matches, or both match...
|
|
;
|
|
; If BOTH namespace and protocol are required to match, don't count if one isn't a match...
|
|
I COND="BOTH" I 'CTPROT!('CTPCKG) QUIT U ;->
|
|
;
|
|
; If 1/2 & SPECIFIC (i.e., MIXED), then SPECIFIC trumps 1/2...
|
|
; (If SPECIFIC not matched, it is not counted)
|
|
I $$MIXED D QUIT:FAIL U ;->
|
|
. S FAIL=1
|
|
. ; If ALL NMSPs to be counted, but specific PROT fails... BAD!
|
|
. I $G(PNMSP)=1!($G(PNMSP)=2) QUIT:'CTPROT ;->
|
|
. ; If ALL PROTs to be counted, but specific PCKG fails... BAD!
|
|
. I $G(IEN101)=1!($G(IEN101)=2) QUIT:'CTPCKG ;->
|
|
. S FAIL=0
|
|
;
|
|
QUIT PROT_U_PCKG
|
|
;
|
|
ALL(V1,V2) ; Are both 1 or 2?
|
|
S V1=$G(V1),V2=$G(V2)
|
|
QUIT:V1'=1&(V1'=2) "" ;->
|
|
QUIT:V2'=1&(V2'=2) "" ;->
|
|
QUIT 1
|
|
;
|
|
MIXED() ; Is one 1/2 and the other SPECIFIC?
|
|
N V3
|
|
S V1=$G(PNMSP),V1=$S(V1]"":$S(V1=1!(V1=2):1,1:0),1:0)
|
|
S V2=$G(IEN101),V2=$S(V2]"":$S(V2=1!(V2=2):1,1:0),1:0)
|
|
S V1=$S(V1=1!(V1=2):1,1:0)
|
|
S V2=$S(V2=1!(V2=2):1,1:0)
|
|
S V3=V1+V2
|
|
QUIT $S(V3=1:1,1:"")
|
|
;
|
|
PROT101(IEN772) ; Return 101 information...
|
|
N IEN,MIEN,NM
|
|
;
|
|
; Get normal protocol information
|
|
S IEN=$P($G(^HL(772,IEN772,0)),U,10)
|
|
S NM=$P($G(^ORD(101,+IEN,0)),U)
|
|
;
|
|
; Maybe this is a Mailman ptr only...
|
|
I NM']"",IEN'>0 D
|
|
. S MIEN=$P($G(^HL(772,+IEN772,0)),U,5) QUIT:MIEN'>0 ;->
|
|
. S NM="XMB",IEN=9999999
|
|
;
|
|
QUIT $S(NM]""!(IEN>0):NM_"~"_IEN,1:"")
|
|
;
|
|
EOR ; HLUCM002 - HL7/Capacity Mgt API ;2/27/01 10:15
|