Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: KMPDHUA

KMPDHUA.m

Go to the documentation of this file.
  1. KMPDHUA ;OAK/RAK - Remote Synchronous HL7 Protocol ;3/15/04 07:48
  1. ;;3.0;KMPD;;Jan 22, 2009;Build 42
  1. ;
  1. EN ;-entry point
  1. ;
  1. N DIC,I,KMPDATE,KMPDNMSP,KMPDPROT,KMPDSRCH,POP,X,Y
  1. N ZTDESC,ZTRTN,ZTSAVE,ZTSK,%ZIS
  1. ;
  1. ; option header
  1. D HDR^KMPDUTL4(" Synchronous Remote Protocol Distribution ") W !!
  1. ; select protocol
  1. S DIC=101,DIC(0)="AELMQZ",DIC("A")="Select Protocol: "
  1. D ^DIC Q:(+Y)<0 S KMPDPROT=Y
  1. ;
  1. ; select namespace (package file)
  1. D NMSPARRY(.KMPDNMSP) Q:'$D(KMPDNMSP)
  1. ;
  1. ; select date range
  1. D DATERNG^KMPDUTL2(.KMPDATE) Q:'KMPDATE
  1. ;
  1. ; element to rate protocols
  1. K DIR
  1. S DIR(0)="SO^1:Message Size;2:Character Transmission Rate;3:Message Transmission Rate"
  1. S DIR("B")=1
  1. D ^DIR Q:$G(Y)=""!($G(Y)="^")
  1. S KMPDSRCH=$S(Y:Y_"^"_$G(Y(0)),1:Y)
  1. ;
  1. ; select output device.
  1. S %ZIS="Q",%ZIS("A")="Device: ",%ZIS("B")="HOME"
  1. W ! D ^%ZIS I POP W !,"No action taken." Q
  1. ; if queued.
  1. I $D(IO("Q")) K IO("Q") D Q
  1. .S ZTDESC="Synchronous Distribution Report"
  1. .S ZTRTN="EN1^KMPDHUA"
  1. .F I="KMPDATE","KMPDNMSP","KMPDPROT","KMPDSRCH" S ZTSAVE(I)=""
  1. .D ^%ZTLOAD W:$G(ZTSK) !,"Task #",ZTSK
  1. .D EXIT
  1. ;
  1. D EN1
  1. ;
  1. Q
  1. ;
  1. EN1 ;-- entry point from taskman
  1. ;
  1. Q:'$G(KMPDATE)
  1. Q:'$D(KMPDNMSP)
  1. Q:'$G(KMPDSRCH)
  1. ;
  1. N END,ERROR,STR,X
  1. ;
  1. S STR=$P(KMPDATE,U),END=$P(KMPDATE,U,2)
  1. Q:'STR!('END)
  1. ;
  1. ; get data from hl7 api
  1. W:'$D(ZTQUEUED) !,"Gathering HL7 data..."
  1. K ^TMP("KMPDH",$J),^TMP("KMPDH-1",$J)
  1. ;
  1. D DATA,PRINT,EXIT
  1. ;
  1. Q
  1. ;
  1. DATA ;
  1. ; if 'all' namespaces
  1. I $G(KMPDNMSP(0))="*" D
  1. .S X=$$CMF^HLUCM(STR,END,1,KMPDPROT,"KMPDH","EITHER",.ERROR)
  1. ; if 'specific' namespaces
  1. E D
  1. .S X=$$CMF^HLUCM(STR,END,.KMPDNMSP,KMPDPROT,"KMPDH","BOTH",.ERROR)
  1. ;
  1. ; determine search list
  1. S FAC=""
  1. F S FAC=$O(^TMP("KMPDH",$J,"RFAC","LR","R",FAC)) Q:FAC="" D
  1. .S NMSP=""
  1. .F S NMSP=$O(^TMP("KMPDH",$J,"RFAC","LR","R",FAC,NMSP)) Q:NMSP="" S TOT=^(NMSP) D
  1. ..; 1 - message size = chr/message
  1. ..; 2 - charater transmission rate - chr/sec/msg
  1. ..; 3 - message transmission rate - sec/msg
  1. ..S SRCH=""
  1. ..I (+KMPDSRCH)=1 S SRCH=$P(TOT,U)/$P(TOT,U,2)
  1. ..I (+KMPDSRCH)=2 S SRCH=($P(TOT,U)/$P(TOT,U,3))/$P(TOT,U,2)
  1. ..I (+KMPDSRCH)=3 S SRCH=$P(TOT,U,3)/$P(TOT,U,2)
  1. ..Q:SRCH=""
  1. ..S ^TMP("KMPDH-1",$J,SRCH,FAC,NMSP)=""
  1. ;
  1. Q
  1. ;
  1. EXIT ;
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. K KMPDATE,KMPDNMSP,KMPDPROT,KMPDSRCH
  1. K ^TMP("KMPDH",$J),^TMP("KMPDH-1",$J)
  1. D ^%ZISC
  1. Q
  1. ;
  1. PRINT ;-- print sync/facility data
  1. N DATA,DATE,FAC,I,J,NMSP,PROT,RANK,SRCH
  1. D HDR
  1. I '$D(^TMP("KMPDH-1",$J)) W !?5," No Data to Report" Q
  1. S SRCH="A",RANK=1
  1. F S SRCH=$O(^TMP("KMPDH-1",$J,SRCH),-1) Q:'SRCH D
  1. .W !,RANK,".",?5,$J($FN(SRCH,",",$S((+KMPDSRCH)=3:2,1:0)),10)
  1. .S FAC="",RANK=RANK+1
  1. .F S FAC=$O(^TMP("KMPDH-1",$J,SRCH,FAC)) Q:FAC="" D
  1. ..W ?17,$E($P(FAC,"~",2),1,18) S NMSP=""
  1. ..F S NMSP=$O(^TMP("KMPDH-1",$J,SRCH,FAC,NMSP)) Q:NMSP="" D
  1. ...W ?37,NMSP S DATE=0 K TOT
  1. ...F S DATE=$O(^TMP("KMPDH",$J,"RFAC","LR","R",FAC,NMSP,DATE)) Q:'DATE D
  1. ....S PROT=""
  1. ....F S PROT=$O(^TMP("KMPDH",$J,"RFAC","LR","R",FAC,NMSP,DATE,PROT)) Q:PROT="" S DATA=^(PROT) D
  1. .....; tcp/mail/unknown
  1. .....S DATA("T")=$G(^TMP("KMPDH",$J,"HR","TM","T",FAC,DATE,NMSP,PROT))
  1. .....S DATA("M")=$G(^TMP("KMPDH",$J,"HR","TM","M",FAC,DATE,NMSP,PROT))
  1. .....S DATA("TMU")=$G(^TMP("KMPDH",$J,"HR","TM","U",FAC,DATE,NMSP,PROT))
  1. .....; incoming/outgoing/unknown
  1. .....S DATA("I")=$G(^TMP("KMPDH",$J,"NMSP","IO","I",FAC,NMSP,DATE,PROT))
  1. .....S DATA("O")=$G(^TMP("KMPDH",$J,"NMSP","IO","O",FAC,NMSP,DATE,PROT))
  1. .....S DATA("IOU")=$G(^TMP("KMPDH",$J,"NMSP","IO","U",FAC,NMSP,DATE,PROT))
  1. .....; calculate sub-totals
  1. .....F I=1:1:3 D
  1. ......S $P(TOT,U,I)=$P($G(TOT),U,I)+$P(DATA,U,I)
  1. ......S $P(TOT("T"),U,I)=$P($G(TOT("T")),U,I)+$P(DATA("T"),U,I)
  1. ......S $P(TOT("M"),U,I)=$P($G(TOT("M")),U,I)+$P(DATA("M"),U,I)
  1. ......S $P(TOT("TMU"),U,I)=$P($G(TOT("TMU")),U,I)+$P(DATA("TMU"),U,I)
  1. ......S $P(TOT("I"),U,I)=$P($G(TOT("I")),U,I)+$P(DATA("I"),U,I)
  1. ......S $P(TOT("O"),U,I)=$P($G(TOT("O")),U,I)+$P(DATA("O"),U,I)
  1. ......S $P(TOT("IOU"),U,I)=$P($G(TOT("IOU")),U,I)+$P(DATA("IOU"),U,I)
  1. ...;
  1. ...; back to NMSP level
  1. ...;
  1. ...W ?45,$J($FN($P(TOT,U),",",0),9)
  1. ...W ?56,$J($FN($P(TOT,U,2),",",0),9)
  1. ...W ?67,$J($FN($P(TOT,U,3),",",0),9)
  1. ...W !
  1. ...F I="T","M","TMU","I","O","IOU" D
  1. ....W ! W:I="I"!(I="L") !
  1. ....W ?21,$S(I="T":"TCP",I="M":"Mail",I="TMU":"T/M Unknown",1:"")
  1. ....W ?21,$S(I="I":"Incoming",I="O":"Outgoing",I="IOU":"I/O Unknown",1:"")
  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)
  1. ..W !
  1. ;
  1. Q
  1. ;
  1. HDR ;
  1. S KMPDATE=$G(KMPDATE)
  1. S KMPDPROT=$G(KMPDPROT)
  1. S KMPDSRCH=$G(KMPDSRCH)
  1. W @IOF
  1. N X
  1. S X=$$SITE^VASITE,X=$P(X,U,2)_" ("_$P(X,U)_")"
  1. W !?(80-$L(X)\2),X,?62,"Printed: ",$$FMTE^XLFDT(DT,2)
  1. W !?21,"Synchronous Remote Protocol Distribution"
  1. S X="'"_$P(KMPDPROT,"^",2)_"'"
  1. W !?((80-$L(X))\2),X
  1. S X=$P($P(KMPDATE,U,3),"@")_": "_$P($P(KMPDATE,U,3),"@",2)
  1. S X=X_" - "_$P($P(KMPDATE,U,4),"@")_": "_$P($P(KMPDATE,U,4),"@",2)
  1. W !?(80-$L(X)\2),X
  1. S X=$P(KMPDSRCH,U)_" - "_$P(KMPDSRCH,U,2)
  1. W !?((80-$L(X))\2),X
  1. S X=$S((+KMPDSRCH)=1:" Chr/Msg",(+KMPDSRCH)=2:"Ch/Sc/Mg",(+KMPDSRCH)=3:" Sec/Msg",1:"OTHER")
  1. W !
  1. W !,"Rank",?6,X,?17,"Remote Facility",?37,"Nmsp",?45,$J("Chrs",9),?56,$J("Messages",9),?67,$J("Seconds",9)
  1. W !,"----",?6,"---------",?17,"------------------",?37,"----",?45,"---------",?56,"---------",?67,"---------"
  1. ;
  1. Q
  1. ;
  1. NMSPARRY(KMPDNMSP) ;-- namespace arry
  1. K KMPDNMSP
  1. N DIC,NM1,NMSP,PKG,X,Y
  1. S DIC=9.4,DIC(0)="AEMQZ",DIC("A")="Select Namespace: "
  1. W ! D SELECT^KMPDUT4("KMPDNMSP",1,5)
  1. Q:$G(KMPDNMSP(0))=""
  1. Q:KMPDNMSP(0)'="*"&($O(KMPDNMSP(0))="")
  1. I KMPDNMSP(0)'="*" K KMPDNMSP(0),NM1 D
  1. .S I="" F S I=$O(KMPDNMSP(I)) Q:I="" S PKG=KMPDNMSP(I) D:PKG
  1. ..S NMSP=$P($G(^DIC(9.4,PKG,0)),U,2)
  1. ..S:NMSP'="" NM1(NMSP)=PKG
  1. ..K KMPDNMSP(I)
  1. .M KMPDNMSP=NM1
  1. ;
  1. Q