KMPDHUA ;OAK/RAK - Remote Synchronous HL7 Protocol ;3/15/04 07:48
;;3.0;KMPD;;Jan 22, 2009;Build 42
;
EN ;-entry point
;
N DIC,I,KMPDATE,KMPDNMSP,KMPDPROT,KMPDSRCH,POP,X,Y
N ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
;
; option header
D HDR^KMPDUTL4(" Synchronous Remote Protocol Distribution ") W !!
; select protocol
S DIC=101,DIC(0)="AELMQZ",DIC("A")="Select Protocol: "
D ^DIC Q:(+Y)<0 S KMPDPROT=Y
;
; select namespace (package file)
D NMSPARRY(.KMPDNMSP) Q:'$D(KMPDNMSP)
;
; select date range
D DATERNG^KMPDUTL2(.KMPDATE) Q:'KMPDATE
;
; element to rate protocols
K DIR
S DIR(0)="SO^1:Message Size;2:Character Transmission Rate;3:Message Transmission Rate"
S DIR("B")=1
D ^DIR Q:$G(Y)=""!($G(Y)="^")
S KMPDSRCH=$S(Y:Y_"^"_$G(Y(0)),1:Y)
;
; select output device.
S %ZIS="Q",%ZIS("A")="Device: ",%ZIS("B")="HOME"
W ! D ^%ZIS I POP W !,"No action taken." Q
; if queued.
I $D(IO("Q")) K IO("Q") D Q
.S ZTDESC="Synchronous Distribution Report"
.S ZTRTN="EN1^KMPDHUA"
.F I="KMPDATE","KMPDNMSP","KMPDPROT","KMPDSRCH" S ZTSAVE(I)=""
.D ^%ZTLOAD W:$G(ZTSK) !,"Task #",ZTSK
.D EXIT
;
D EN1
;
Q
;
EN1 ;-- entry point from taskman
;
Q:'$G(KMPDATE)
Q:'$D(KMPDNMSP)
Q:'$G(KMPDSRCH)
;
N END,ERROR,STR,X
;
S STR=$P(KMPDATE,U),END=$P(KMPDATE,U,2)
Q:'STR!('END)
;
; get data from hl7 api
W:'$D(ZTQUEUED) !,"Gathering HL7 data..."
K ^TMP("KMPDH",$J),^TMP("KMPDH-1",$J)
;
D DATA,PRINT,EXIT
;
Q
;
DATA ;
; if 'all' namespaces
I $G(KMPDNMSP(0))="*" D
.S X=$$CMF^HLUCM(STR,END,1,KMPDPROT,"KMPDH","EITHER",.ERROR)
; if 'specific' namespaces
E D
.S X=$$CMF^HLUCM(STR,END,.KMPDNMSP,KMPDPROT,"KMPDH","BOTH",.ERROR)
;
; determine search list
S FAC=""
F S FAC=$O(^TMP("KMPDH",$J,"RFAC","LR","R",FAC)) Q:FAC="" D
.S NMSP=""
.F S NMSP=$O(^TMP("KMPDH",$J,"RFAC","LR","R",FAC,NMSP)) Q:NMSP="" S TOT=^(NMSP) D
..; 1 - message size = chr/message
..; 2 - charater transmission rate - chr/sec/msg
..; 3 - message transmission rate - sec/msg
..S SRCH=""
..I (+KMPDSRCH)=1 S SRCH=$P(TOT,U)/$P(TOT,U,2)
..I (+KMPDSRCH)=2 S SRCH=($P(TOT,U)/$P(TOT,U,3))/$P(TOT,U,2)
..I (+KMPDSRCH)=3 S SRCH=$P(TOT,U,3)/$P(TOT,U,2)
..Q:SRCH=""
..S ^TMP("KMPDH-1",$J,SRCH,FAC,NMSP)=""
;
Q
;
EXIT ;
S:$D(ZTQUEUED) ZTREQ="@"
K KMPDATE,KMPDNMSP,KMPDPROT,KMPDSRCH
K ^TMP("KMPDH",$J),^TMP("KMPDH-1",$J)
D ^%ZISC
Q
;
PRINT ;-- print sync/facility data
N DATA,DATE,FAC,I,J,NMSP,PROT,RANK,SRCH
D HDR
I '$D(^TMP("KMPDH-1",$J)) W !?5," No Data to Report" Q
S SRCH="A",RANK=1
F S SRCH=$O(^TMP("KMPDH-1",$J,SRCH),-1) Q:'SRCH D
.W !,RANK,".",?5,$J($FN(SRCH,",",$S((+KMPDSRCH)=3:2,1:0)),10)
.S FAC="",RANK=RANK+1
.F S FAC=$O(^TMP("KMPDH-1",$J,SRCH,FAC)) Q:FAC="" D
..W ?17,$E($P(FAC,"~",2),1,18) S NMSP=""
..F S NMSP=$O(^TMP("KMPDH-1",$J,SRCH,FAC,NMSP)) Q:NMSP="" D
...W ?37,NMSP S DATE=0 K TOT
...F S DATE=$O(^TMP("KMPDH",$J,"RFAC","LR","R",FAC,NMSP,DATE)) Q:'DATE D
....S PROT=""
....F S PROT=$O(^TMP("KMPDH",$J,"RFAC","LR","R",FAC,NMSP,DATE,PROT)) Q:PROT="" S DATA=^(PROT) D
.....; tcp/mail/unknown
.....S DATA("T")=$G(^TMP("KMPDH",$J,"HR","TM","T",FAC,DATE,NMSP,PROT))
.....S DATA("M")=$G(^TMP("KMPDH",$J,"HR","TM","M",FAC,DATE,NMSP,PROT))
.....S DATA("TMU")=$G(^TMP("KMPDH",$J,"HR","TM","U",FAC,DATE,NMSP,PROT))
.....; incoming/outgoing/unknown
.....S DATA("I")=$G(^TMP("KMPDH",$J,"NMSP","IO","I",FAC,NMSP,DATE,PROT))
.....S DATA("O")=$G(^TMP("KMPDH",$J,"NMSP","IO","O",FAC,NMSP,DATE,PROT))
.....S DATA("IOU")=$G(^TMP("KMPDH",$J,"NMSP","IO","U",FAC,NMSP,DATE,PROT))
.....; calculate sub-totals
.....F I=1:1:3 D
......S $P(TOT,U,I)=$P($G(TOT),U,I)+$P(DATA,U,I)
......S $P(TOT("T"),U,I)=$P($G(TOT("T")),U,I)+$P(DATA("T"),U,I)
......S $P(TOT("M"),U,I)=$P($G(TOT("M")),U,I)+$P(DATA("M"),U,I)
......S $P(TOT("TMU"),U,I)=$P($G(TOT("TMU")),U,I)+$P(DATA("TMU"),U,I)
......S $P(TOT("I"),U,I)=$P($G(TOT("I")),U,I)+$P(DATA("I"),U,I)
......S $P(TOT("O"),U,I)=$P($G(TOT("O")),U,I)+$P(DATA("O"),U,I)
......S $P(TOT("IOU"),U,I)=$P($G(TOT("IOU")),U,I)+$P(DATA("IOU"),U,I)
...;
...; back to NMSP level
...;
...W ?45,$J($FN($P(TOT,U),",",0),9)
...W ?56,$J($FN($P(TOT,U,2),",",0),9)
...W ?67,$J($FN($P(TOT,U,3),",",0),9)
...W !
...F I="T","M","TMU","I","O","IOU" D
....W ! W:I="I"!(I="L") !
....W ?21,$S(I="T":"TCP",I="M":"Mail",I="TMU":"T/M Unknown",1:"")
....W ?21,$S(I="I":"Incoming",I="O":"Outgoing",I="IOU":"I/O Unknown",1:"")
....F J=1:1:3 W ?$S(J=1:45,J=2:56,1:67),$J($FN($P($G(TOT(I)),U,J),",",0),9)
..W !
;
Q
;
HDR ;
S KMPDATE=$G(KMPDATE)
S KMPDPROT=$G(KMPDPROT)
S KMPDSRCH=$G(KMPDSRCH)
W @IOF
N X
S X=$$SITE^VASITE,X=$P(X,U,2)_" ("_$P(X,U)_")"
W !?(80-$L(X)\2),X,?62,"Printed: ",$$FMTE^XLFDT(DT,2)
W !?21,"Synchronous Remote Protocol Distribution"
S X="'"_$P(KMPDPROT,"^",2)_"'"
W !?((80-$L(X))\2),X
S X=$P($P(KMPDATE,U,3),"@")_": "_$P($P(KMPDATE,U,3),"@",2)
S X=X_" - "_$P($P(KMPDATE,U,4),"@")_": "_$P($P(KMPDATE,U,4),"@",2)
W !?(80-$L(X)\2),X
S X=$P(KMPDSRCH,U)_" - "_$P(KMPDSRCH,U,2)
W !?((80-$L(X))\2),X
S X=$S((+KMPDSRCH)=1:" Chr/Msg",(+KMPDSRCH)=2:"Ch/Sc/Mg",(+KMPDSRCH)=3:" Sec/Msg",1:"OTHER")
W !
W !,"Rank",?6,X,?17,"Remote Facility",?37,"Nmsp",?45,$J("Chrs",9),?56,$J("Messages",9),?67,$J("Seconds",9)
W !,"----",?6,"---------",?17,"------------------",?37,"----",?45,"---------",?56,"---------",?67,"---------"
;
Q
;
NMSPARRY(KMPDNMSP) ;-- namespace arry
K KMPDNMSP
N DIC,NM1,NMSP,PKG,X,Y
S DIC=9.4,DIC(0)="AEMQZ",DIC("A")="Select Namespace: "
W ! D SELECT^KMPDUT4("KMPDNMSP",1,5)
Q:$G(KMPDNMSP(0))=""
Q:KMPDNMSP(0)'="*"&($O(KMPDNMSP(0))="")
I KMPDNMSP(0)'="*" K KMPDNMSP(0),NM1 D
.S I="" F S I=$O(KMPDNMSP(I)) Q:I="" S PKG=KMPDNMSP(I) D:PKG
..S NMSP=$P($G(^DIC(9.4,PKG,0)),U,2)
..S:NMSP'="" NM1(NMSP)=PKG
..K KMPDNMSP(I)
.M KMPDNMSP=NM1
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HKMPDHUA 5952 printed Dec 13, 2024@01:40:36 Page 2
KMPDHUA ;OAK/RAK - Remote Synchronous HL7 Protocol ;3/15/04 07:48
+1 ;;3.0;KMPD;;Jan 22, 2009;Build 42
+2 ;
EN ;-entry point
+1 ;
+2 NEW DIC,I,KMPDATE,KMPDNMSP,KMPDPROT,KMPDSRCH,POP,X,Y
+3 NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
+4 ;
+5 ; option header
+6 DO HDR^KMPDUTL4(" Synchronous Remote Protocol Distribution ")
WRITE !!
+7 ; select protocol
+8 SET DIC=101
SET DIC(0)="AELMQZ"
SET DIC("A")="Select Protocol: "
+9 DO ^DIC
if (+Y)<0
QUIT
SET KMPDPROT=Y
+10 ;
+11 ; select namespace (package file)
+12 DO NMSPARRY(.KMPDNMSP)
if '$DATA(KMPDNMSP)
QUIT
+13 ;
+14 ; select date range
+15 DO DATERNG^KMPDUTL2(.KMPDATE)
if 'KMPDATE
QUIT
+16 ;
+17 ; element to rate protocols
+18 KILL DIR
+19 SET DIR(0)="SO^1:Message Size;2:Character Transmission Rate;3:Message Transmission Rate"
+20 SET DIR("B")=1
+21 DO ^DIR
if $GET(Y)=""!($GET(Y)="^")
QUIT
+22 SET KMPDSRCH=$SELECT(Y:Y_"^"_$GET(Y(0)),1:Y)
+23 ;
+24 ; select output device.
+25 SET %ZIS="Q"
SET %ZIS("A")="Device: "
SET %ZIS("B")="HOME"
+26 WRITE !
DO ^%ZIS
IF POP
WRITE !,"No action taken."
QUIT
+27 ; if queued.
+28 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+29 SET ZTDESC="Synchronous Distribution Report"
+30 SET ZTRTN="EN1^KMPDHUA"
+31 FOR I="KMPDATE","KMPDNMSP","KMPDPROT","KMPDSRCH"
SET ZTSAVE(I)=""
+32 DO ^%ZTLOAD
if $GET(ZTSK)
WRITE !,"Task #",ZTSK
+33 DO EXIT
End DoDot:1
QUIT
+34 ;
+35 DO EN1
+36 ;
+37 QUIT
+38 ;
EN1 ;-- entry point from taskman
+1 ;
+2 if '$GET(KMPDATE)
QUIT
+3 if '$DATA(KMPDNMSP)
QUIT
+4 if '$GET(KMPDSRCH)
QUIT
+5 ;
+6 NEW END,ERROR,STR,X
+7 ;
+8 SET STR=$PIECE(KMPDATE,U)
SET END=$PIECE(KMPDATE,U,2)
+9 if 'STR!('END)
QUIT
+10 ;
+11 ; get data from hl7 api
+12 if '$DATA(ZTQUEUED)
WRITE !,"Gathering HL7 data..."
+13 KILL ^TMP("KMPDH",$JOB),^TMP("KMPDH-1",$JOB)
+14 ;
+15 DO DATA
DO PRINT
DO EXIT
+16 ;
+17 QUIT
+18 ;
DATA ;
+1 ; if 'all' namespaces
+2 IF $GET(KMPDNMSP(0))="*"
Begin DoDot:1
+3 SET X=$$CMF^HLUCM(STR,END,1,KMPDPROT,"KMPDH","EITHER",.ERROR)
End DoDot:1
+4 ; if 'specific' namespaces
+5 IF '$TEST
Begin DoDot:1
+6 SET X=$$CMF^HLUCM(STR,END,.KMPDNMSP,KMPDPROT,"KMPDH","BOTH",.ERROR)
End DoDot:1
+7 ;
+8 ; determine search list
+9 SET FAC=""
+10 FOR
SET FAC=$ORDER(^TMP("KMPDH",$JOB,"RFAC","LR","R",FAC))
if FAC=""
QUIT
Begin DoDot:1
+11 SET NMSP=""
+12 FOR
SET NMSP=$ORDER(^TMP("KMPDH",$JOB,"RFAC","LR","R",FAC,NMSP))
if NMSP=""
QUIT
SET TOT=^(NMSP)
Begin DoDot:2
+13 ; 1 - message size = chr/message
+14 ; 2 - charater transmission rate - chr/sec/msg
+15 ; 3 - message transmission rate - sec/msg
+16 SET SRCH=""
+17 IF (+KMPDSRCH)=1
SET SRCH=$PIECE(TOT,U)/$PIECE(TOT,U,2)
+18 IF (+KMPDSRCH)=2
SET SRCH=($PIECE(TOT,U)/$PIECE(TOT,U,3))/$PIECE(TOT,U,2)
+19 IF (+KMPDSRCH)=3
SET SRCH=$PIECE(TOT,U,3)/$PIECE(TOT,U,2)
+20 if SRCH=""
QUIT
+21 SET ^TMP("KMPDH-1",$JOB,SRCH,FAC,NMSP)=""
End DoDot:2
End DoDot:1
+22 ;
+23 QUIT
+24 ;
EXIT ;
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL KMPDATE,KMPDNMSP,KMPDPROT,KMPDSRCH
+3 KILL ^TMP("KMPDH",$JOB),^TMP("KMPDH-1",$JOB)
+4 DO ^%ZISC
+5 QUIT
+6 ;
PRINT ;-- print sync/facility data
+1 NEW DATA,DATE,FAC,I,J,NMSP,PROT,RANK,SRCH
+2 DO HDR
+3 IF '$DATA(^TMP("KMPDH-1",$JOB))
WRITE !?5," No Data to Report"
QUIT
+4 SET SRCH="A"
SET RANK=1
+5 FOR
SET SRCH=$ORDER(^TMP("KMPDH-1",$JOB,SRCH),-1)
if 'SRCH
QUIT
Begin DoDot:1
+6 WRITE !,RANK,".",?5,$JUSTIFY($FNUMBER(SRCH,",",$SELECT((+KMPDSRCH)=3:2,1:0)),10)
+7 SET FAC=""
SET RANK=RANK+1
+8 FOR
SET FAC=$ORDER(^TMP("KMPDH-1",$JOB,SRCH,FAC))
if FAC=""
QUIT
Begin DoDot:2
+9 WRITE ?17,$EXTRACT($PIECE(FAC,"~",2),1,18)
SET NMSP=""
+10 FOR
SET NMSP=$ORDER(^TMP("KMPDH-1",$JOB,SRCH,FAC,NMSP))
if NMSP=""
QUIT
Begin DoDot:3
+11 WRITE ?37,NMSP
SET DATE=0
KILL TOT
+12 FOR
SET DATE=$ORDER(^TMP("KMPDH",$JOB,"RFAC","LR","R",FAC,NMSP,DATE))
if 'DATE
QUIT
Begin DoDot:4
+13 SET PROT=""
+14 FOR
SET PROT=$ORDER(^TMP("KMPDH",$JOB,"RFAC","LR","R",FAC,NMSP,DATE,PROT))
if PROT=""
QUIT
SET DATA=^(PROT)
Begin DoDot:5
+15 ; tcp/mail/unknown
+16 SET DATA("T")=$GET(^TMP("KMPDH",$JOB,"HR","TM","T",FAC,DATE,NMSP,PROT))
+17 SET DATA("M")=$GET(^TMP("KMPDH",$JOB,"HR","TM","M",FAC,DATE,NMSP,PROT))
+18 SET DATA("TMU")=$GET(^TMP("KMPDH",$JOB,"HR","TM","U",FAC,DATE,NMSP,PROT))
+19 ; incoming/outgoing/unknown
+20 SET DATA("I")=$GET(^TMP("KMPDH",$JOB,"NMSP","IO","I",FAC,NMSP,DATE,PROT))
+21 SET DATA("O")=$GET(^TMP("KMPDH",$JOB,"NMSP","IO","O",FAC,NMSP,DATE,PROT))
+22 SET DATA("IOU")=$GET(^TMP("KMPDH",$JOB,"NMSP","IO","U",FAC,NMSP,DATE,PROT))
+23 ; calculate sub-totals
+24 FOR I=1:1:3
Begin DoDot:6
+25 SET $PIECE(TOT,U,I)=$PIECE($GET(TOT),U,I)+$PIECE(DATA,U,I)
+26 SET $PIECE(TOT("T"),U,I)=$PIECE($GET(TOT("T")),U,I)+$PIECE(DATA("T"),U,I)
+27 SET $PIECE(TOT("M"),U,I)=$PIECE($GET(TOT("M")),U,I)+$PIECE(DATA("M"),U,I)
+28 SET $PIECE(TOT("TMU"),U,I)=$PIECE($GET(TOT("TMU")),U,I)+$PIECE(DATA("TMU"),U,I)
+29 SET $PIECE(TOT("I"),U,I)=$PIECE($GET(TOT("I")),U,I)+$PIECE(DATA("I"),U,I)
+30 SET $PIECE(TOT("O"),U,I)=$PIECE($GET(TOT("O")),U,I)+$PIECE(DATA("O"),U,I)
+31 SET $PIECE(TOT("IOU"),U,I)=$PIECE($GET(TOT("IOU")),U,I)+$PIECE(DATA("IOU"),U,I)
End DoDot:6
End DoDot:5
End DoDot:4
+32 ;
+33 ; back to NMSP level
+34 ;
+35 WRITE ?45,$JUSTIFY($FNUMBER($PIECE(TOT,U),",",0),9)
+36 WRITE ?56,$JUSTIFY($FNUMBER($PIECE(TOT,U,2),",",0),9)
+37 WRITE ?67,$JUSTIFY($FNUMBER($PIECE(TOT,U,3),",",0),9)
+38 WRITE !
+39 FOR I="T","M","TMU","I","O","IOU"
Begin DoDot:4
+40 WRITE !
if I="I"!(I="L")
WRITE !
+41 WRITE ?21,$SELECT(I="T":"TCP",I="M":"Mail",I="TMU":"T/M Unknown",1:"")
+42 WRITE ?21,$SELECT(I="I":"Incoming",I="O":"Outgoing",I="IOU":"I/O Unknown",1:"")
+43 FOR J=1:1:3
WRITE ?$SELECT(J=1:45,J=2:56,1:67),$JUSTIFY($FNUMBER($PIECE($GET(TOT(I)),U,J),",",0),9)
End DoDot:4
End DoDot:3
+44 WRITE !
End DoDot:2
End DoDot:1
+45 ;
+46 QUIT
+47 ;
HDR ;
+1 SET KMPDATE=$GET(KMPDATE)
+2 SET KMPDPROT=$GET(KMPDPROT)
+3 SET KMPDSRCH=$GET(KMPDSRCH)
+4 WRITE @IOF
+5 NEW X
+6 SET X=$$SITE^VASITE
SET X=$PIECE(X,U,2)_" ("_$PIECE(X,U)_")"
+7 WRITE !?(80-$LENGTH(X)\2),X,?62,"Printed: ",$$FMTE^XLFDT(DT,2)
+8 WRITE !?21,"Synchronous Remote Protocol Distribution"
+9 SET X="'"_$PIECE(KMPDPROT,"^",2)_"'"
+10 WRITE !?((80-$LENGTH(X))\2),X
+11 SET X=$PIECE($PIECE(KMPDATE,U,3),"@")_": "_$PIECE($PIECE(KMPDATE,U,3),"@",2)
+12 SET X=X_" - "_$PIECE($PIECE(KMPDATE,U,4),"@")_": "_$PIECE($PIECE(KMPDATE,U,4),"@",2)
+13 WRITE !?(80-$LENGTH(X)\2),X
+14 SET X=$PIECE(KMPDSRCH,U)_" - "_$PIECE(KMPDSRCH,U,2)
+15 WRITE !?((80-$LENGTH(X))\2),X
+16 SET X=$SELECT((+KMPDSRCH)=1:" Chr/Msg",(+KMPDSRCH)=2:"Ch/Sc/Mg",(+KMPDSRCH)=3:" Sec/Msg",1:"OTHER")
+17 WRITE !
+18 WRITE !,"Rank",?6,X,?17,"Remote Facility",?37,"Nmsp",?45,$JUSTIFY("Chrs",9),?56,$JUSTIFY("Messages",9),?67,$JUSTIFY("Seconds",9)
+19 WRITE !,"----",?6,"---------",?17,"------------------",?37,"----",?45,"---------",?56,"---------",?67,"---------"
+20 ;
+21 QUIT
+22 ;
NMSPARRY(KMPDNMSP) ;-- namespace arry
+1 KILL KMPDNMSP
+2 NEW DIC,NM1,NMSP,PKG,X,Y
+3 SET DIC=9.4
SET DIC(0)="AEMQZ"
SET DIC("A")="Select Namespace: "
+4 WRITE !
DO SELECT^KMPDUT4("KMPDNMSP",1,5)
+5 if $GET(KMPDNMSP(0))=""
QUIT
+6 if KMPDNMSP(0)'="*"&($ORDER(KMPDNMSP(0))="")
QUIT
+7 IF KMPDNMSP(0)'="*"
KILL KMPDNMSP(0),NM1
Begin DoDot:1
+8 SET I=""
FOR
SET I=$ORDER(KMPDNMSP(I))
if I=""
QUIT
SET PKG=KMPDNMSP(I)
if PKG
Begin DoDot:2
+9 SET NMSP=$PIECE($GET(^DIC(9.4,PKG,0)),U,2)
+10 if NMSP'=""
SET NM1(NMSP)=PKG
+11 KILL KMPDNMSP(I)
End DoDot:2
+12 MERGE KMPDNMSP=NM1
End DoDot:1
+13 ;
+14 QUIT
