AGMPHLU2 ; IHS/SD/TPF - MPI HLO UTILITIES ; 12/15/2007
;;7.2;IHS PATIENT REGISTRATION;**1,6**;JAN 07, 2011;Build 23
Q
MSGSTAT ;UNSUCCESSFUL STATUS REPORT
N MSGIEN,STATUS,STATTYP,CLEAR,EESC,TOTMSG,MSGDATE,TOTCLEAR,DATES
ASKFROM ;EP
K DIR
S DIR(0)="DO^::E"
S DIR("A")="Enter from Date"
S DIR("B")="T"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y="")
S FROM=Y
ASKTO ;EP
K DIR
S DIR(0)="DO^::E"
S DIR("A")="Enter to Date"
S DIR("B")="T"
D ^DIR
G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y="") ASKFROM
S TO=Y_".999999"
I FROM>TO D G ASKFROM
.W !!,"FROM DATE CAN NOT BE GREATER THAN TO DATE!!" H 2
ASKCLEAR ;EP
K DIR
S DIR(0)="YO"
S DIR("A")="Do you wish to set unsuccessful statuses to successful"
S DIR("B")="N"
D ^DIR
G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y="") ASKTO
S CLEAR=Y
REPEAT ;EP -
S TYPEEVNT="" F S TYPEEVNT=$O(TYPEEVNT(TYPEEVNT)) Q:TYPEEVNT="" S TYPEEVNT(TYPEEVNT)=0
S ESC=0
D NOW^%DTC S Y=% X ^DD("DD") S PRTDATE=Y
K DATES
S $P(DASH,"-",81)=""
S PAGE=1
S (TOTMSG,TOTCLEAR)=0
S MSGDATE=FROM-.01
F S MSGDATE=$O(^HLA("B",MSGDATE)) Q:MSGDATE=""!(ESC) D
.Q:+MSGDATE>TO!(+MSGDATE<FROM)
.S REC=""
.F S REC=$O(^HLA("B",MSGDATE,REC)) Q:REC="" D
..S LINK=$P($G(^HLB(REC,0)),U,5)
..Q:LINK'="MPI"
..S STATUS=$P($G(^HLB(REC,0)),U,20)
..Q:STATUS="SU"
..S DIREC=$P($G(^HLB(REC,0)),U,4)
..;Q:DIREC'="I" ;ONLY CARE ABOUT INcoming
..S TOTMSG=TOTMSG+1
..S DATES=$P(MSGDATE,".")
..S DATES(DATES)=$G(DATES(DATES))+1
..I CLEAR S $P(^HLB(REC,0),U,20)="SU" S TOTCLEAR=TOTCLEAR+1 Q
..S MSGBOD=$P($P($G(^HLB(REC,0)),U)," ",2)
..S MSGTYPE=$P($G(^HLA(MSGBOD,0)),U,3)
..S EVENT=$P($G(^HLA(MSGBOD,0)),U,4)
..S TYPEEVNT=EVENT_U_MSGTYPE
..S TYPEEVNT(TYPEEVNT)=$G(TYPEEVNT(TYPEEVNT))+1
..S SEG=$G(^HLA(MSGBOD,1,1,0))
..;W !!,MSGDATE
..;W !,REC," ",DIREC
..;W !,MSGTYPE," ",EVENT
..;W !,"SEGMENT: ",SEG
D BYDTHDR
S TYPEEVNT=""
F CNT=1:1 S TYPEEVNT=$O(TYPEEVNT(TYPEEVNT)) Q:TYPEEVNT=""!ESC D
.I CNT'=1,(FIRST'=$P(TYPEEVNT,U)) W !!
.S FIRST=$P(TYPEEVNT,U)
.W !,TYPEEVNT,?12,$J(TYPEEVNT(TYPEEVNT),10)
.W:TOTMSG ?25,$J($FN(TYPEEVNT(TYPEEVNT)/TOTMSG*100,",",2),10)
W !?16,"-------"
W !?13,$J(TOTMSG,10)
I CLEAR W !,"CLEARED: ",TOTCLEAR
Q
;
BYDTHDR ;EP - RPTBYDT HEADER
W @IOF
W !,$$C^XBFUNC("UNSUCCESSFUL MESSAGE REPORT BY DATE",IOM)
W ?70,"PAGE ",PAGE
W !,$$CJ^XLFSTR("DATE PRINTED: "_PRTDATE,IOM)
W !,$$CJ^XLFSTR("PRINTED BY: "_$P($G(^VA(200,DUZ,0)),U),IOM)
W !,$$CJ^XLFSTR("AT FACILITY: "_$P($G(^DIC(4,DUZ(2),0)),U),IOM)
S Y=FROM X ^DD("DD") S EXFROM=Y
S Y=TO X ^DD("DD") S EXTO=Y
W !,$$CJ^XLFSTR("FOR MESSAGES FROM "_EXFROM_" TO "_EXTO,IOM)
S DATES=""
F S DATES=$O(DATES(DATES)) Q:'DATES D
.S Y=DATES X ^DD("DD") S EXDATE=Y
.W !,"TOTAL MSGS FOR ",EXDATE," IS ",DATES(DATES)
W !,DASH,!!
W !!,"EVENT^TYPE",?16,"TOTAL",?25,"% OF TOTAL"
W !,"---------------------------------------"
S PAGE=PAGE+1
Q
;
QUEVSENT ;EP - MSGS IN QUEUE VS TOTAL MSGS
W @IOF
N HLOG,PORT,MPILINK,REC,OUTCOUNT,TOTCOUNT,INCOUNT,MSGTYPE,EVENT,MPIIEN,ESC
S ESC=0
S HLOG=$O(^HLCS(870,"B","MPI","")) ;MPI LOGICAL LINK
S PORT=$$GET1^DIQ(870,HLOG_",",400.08,"E") ;TCP/IP PORT (OPTIMIZED)
S MPILINK="MPI:"_PORT
S (TOTCOUNT,OUTCOUNT,INCOUNT)=0
S TRANDATE=""
F S TRANDATE=$O(^HLB("QUEUE","IN",TRANDATE)) Q:'TRANDATE D
.S MSGTYPE=""
.F S MSGTYPE=$O(^HLB("QUEUE","IN",TRANDATE,"RPMS-MPI",MSGTYPE)) Q:MSGTYPE="" D
..S EVENT=""
..F S EVENT=$O(^HLB("QUEUE","IN",TRANDATE,"RPMS-MPI",MSGTYPE,EVENT)) Q:EVENT="" D
...S MPIIEN=""
...F S MPIIEN=$O(^HLB("QUEUE","IN",TRANDATE,"RPMS-MPI",MSGTYPE,EVENT,MPIIEN)) Q:MPIIEN="" D
....S INCOUNT=INCOUNT+1
S MPIIEN=""
F S MPIIEN=$O(^HLB("QUEUE","OUT",MPILINK,"MPI RPMS",MPIIEN)) Q:'MPIIEN D
.S OUTCOUNT=OUTCOUNT+1
S MPIIEN=0
F S MPIIEN=$O(^HLB(MPIIEN)) Q:'MPIIEN D
.S LINK=$P($G(^HLB(MPIIEN,0)),U,5)
.Q:LINK'="MPI"
.S TOTCOUNT=TOTCOUNT+1
W !!," MESSAGES IN THE IN QUEUE: ",$J($FN(INCOUNT,","),9)
W !," MESSAGES IN OUT QUEUE: ",$J($FN(OUTCOUNT,","),9)
W !,"TOTAL MESSAGES IN HLO GLOBALS: ",$J($FN(TOTCOUNT,","),9)
I '$D(ZTQUEUED) D Q:ESC
.U 0
.W !
.K DIR
.S DIR(0)="E"
.D ^DIR
.S ESC=X=U
I '$D(ZTQUEUED) G QUEVSENT
Q
AGMPHLU2 ; IHS/SD/TPF - MPI HLO UTILITIES ; 12/15/2007
+1 ;;7.2;IHS PATIENT REGISTRATION;**1,6**;JAN 07, 2011;Build 23
+2 QUIT
MSGSTAT ;UNSUCCESSFUL STATUS REPORT
+1 NEW MSGIEN,STATUS,STATTYP,CLEAR,EESC,TOTMSG,MSGDATE,TOTCLEAR,DATES
ASKFROM ;EP
+1 KILL DIR
+2 SET DIR(0)="DO^::E"
+3 SET DIR("A")="Enter from Date"
+4 SET DIR("B")="T"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(Y="")
QUIT
+7 SET FROM=Y
ASKTO ;EP
+1 KILL DIR
+2 SET DIR(0)="DO^::E"
+3 SET DIR("A")="Enter to Date"
+4 SET DIR("B")="T"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(Y="")
GOTO ASKFROM
+7 SET TO=Y_".999999"
+8 IF FROM>TO
Begin DoDot:1
+9 WRITE !!,"FROM DATE CAN NOT BE GREATER THAN TO DATE!!"
HANG 2
End DoDot:1
GOTO ASKFROM
ASKCLEAR ;EP
+1 KILL DIR
+2 SET DIR(0)="YO"
+3 SET DIR("A")="Do you wish to set unsuccessful statuses to successful"
+4 SET DIR("B")="N"
+5 DO ^DIR
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(Y="")
GOTO ASKTO
+7 SET CLEAR=Y
REPEAT ;EP -
+1 SET TYPEEVNT=""
FOR
SET TYPEEVNT=$ORDER(TYPEEVNT(TYPEEVNT))
IF TYPEEVNT=""
QUIT
SET TYPEEVNT(TYPEEVNT)=0
+2 SET ESC=0
+3 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET PRTDATE=Y
+4 KILL DATES
+5 SET $PIECE(DASH,"-",81)=""
+6 SET PAGE=1
+7 SET (TOTMSG,TOTCLEAR)=0
+8 SET MSGDATE=FROM-.01
+9 FOR
SET MSGDATE=$ORDER(^HLA("B",MSGDATE))
IF MSGDATE=""!(ESC)
QUIT
Begin DoDot:1
+10 IF +MSGDATE>TO!(+MSGDATE<FROM)
QUIT
+11 SET REC=""
+12 FOR
SET REC=$ORDER(^HLA("B",MSGDATE,REC))
IF REC=""
QUIT
Begin DoDot:2
+13 SET LINK=$PIECE($GET(^HLB(REC,0)),U,5)
+14 IF LINK'="MPI"
QUIT
+15 SET STATUS=$PIECE($GET(^HLB(REC,0)),U,20)
+16 IF STATUS="SU"
QUIT
+17 SET DIREC=$PIECE($GET(^HLB(REC,0)),U,4)
+18 ;Q:DIREC'="I" ;ONLY CARE ABOUT INcoming
+19 SET TOTMSG=TOTMSG+1
+20 SET DATES=$PIECE(MSGDATE,".")
+21 SET DATES(DATES)=$GET(DATES(DATES))+1
+22 IF CLEAR
SET $PIECE(^HLB(REC,0),U,20)="SU"
SET TOTCLEAR=TOTCLEAR+1
QUIT
+23 SET MSGBOD=$PIECE($PIECE($GET(^HLB(REC,0)),U)," ",2)
+24 SET MSGTYPE=$PIECE($GET(^HLA(MSGBOD,0)),U,3)
+25 SET EVENT=$PIECE($GET(^HLA(MSGBOD,0)),U,4)
+26 SET TYPEEVNT=EVENT_U_MSGTYPE
+27 SET TYPEEVNT(TYPEEVNT)=$GET(TYPEEVNT(TYPEEVNT))+1
+28 SET SEG=$GET(^HLA(MSGBOD,1,1,0))
+29 ;W !!,MSGDATE
+30 ;W !,REC," ",DIREC
+31 ;W !,MSGTYPE," ",EVENT
+32 ;W !,"SEGMENT: ",SEG
End DoDot:2
End DoDot:1
+33 DO BYDTHDR
+34 SET TYPEEVNT=""
+35 FOR CNT=1:1
SET TYPEEVNT=$ORDER(TYPEEVNT(TYPEEVNT))
IF TYPEEVNT=""!ESC
QUIT
Begin DoDot:1
+36 IF CNT'=1
IF (FIRST'=$PIECE(TYPEEVNT,U))
WRITE !!
+37 SET FIRST=$PIECE(TYPEEVNT,U)
+38 WRITE !,TYPEEVNT,?12,$JUSTIFY(TYPEEVNT(TYPEEVNT),10)
+39 IF TOTMSG
WRITE ?25,$JUSTIFY($FNUMBER(TYPEEVNT(TYPEEVNT)/TOTMSG*100,",",2),10)
End DoDot:1
+40 WRITE !?16,"-------"
+41 WRITE !?13,$JUSTIFY(TOTMSG,10)
+42 IF CLEAR
WRITE !,"CLEARED: ",TOTCLEAR
+43 QUIT
+44 ;
BYDTHDR ;EP - RPTBYDT HEADER
+1 WRITE @IOF
+2 WRITE !,$$C^XBFUNC("UNSUCCESSFUL MESSAGE REPORT BY DATE",IOM)
+3 WRITE ?70,"PAGE ",PAGE
+4 WRITE !,$$CJ^XLFSTR("DATE PRINTED: "_PRTDATE,IOM)
+5 WRITE !,$$CJ^XLFSTR("PRINTED BY: "_$PIECE($GET(^VA(200,DUZ,0)),U),IOM)
+6 WRITE !,$$CJ^XLFSTR("AT FACILITY: "_$PIECE($GET(^DIC(4,DUZ(2),0)),U),IOM)
+7 SET Y=FROM
XECUTE ^DD("DD")
SET EXFROM=Y
+8 SET Y=TO
XECUTE ^DD("DD")
SET EXTO=Y
+9 WRITE !,$$CJ^XLFSTR("FOR MESSAGES FROM "_EXFROM_" TO "_EXTO,IOM)
+10 SET DATES=""
+11 FOR
SET DATES=$ORDER(DATES(DATES))
IF 'DATES
QUIT
Begin DoDot:1
+12 SET Y=DATES
XECUTE ^DD("DD")
SET EXDATE=Y
+13 WRITE !,"TOTAL MSGS FOR ",EXDATE," IS ",DATES(DATES)
End DoDot:1
+14 WRITE !,DASH,!!
+15 WRITE !!,"EVENT^TYPE",?16,"TOTAL",?25,"% OF TOTAL"
+16 WRITE !,"---------------------------------------"
+17 SET PAGE=PAGE+1
+18 QUIT
+19 ;
QUEVSENT ;EP - MSGS IN QUEUE VS TOTAL MSGS
+1 WRITE @IOF
+2 NEW HLOG,PORT,MPILINK,REC,OUTCOUNT,TOTCOUNT,INCOUNT,MSGTYPE,EVENT,MPIIEN,ESC
+3 SET ESC=0
+4 ;MPI LOGICAL LINK
SET HLOG=$ORDER(^HLCS(870,"B","MPI",""))
+5 ;TCP/IP PORT (OPTIMIZED)
SET PORT=$$GET1^DIQ(870,HLOG_",",400.08,"E")
+6 SET MPILINK="MPI:"_PORT
+7 SET (TOTCOUNT,OUTCOUNT,INCOUNT)=0
+8 SET TRANDATE=""
+9 FOR
SET TRANDATE=$ORDER(^HLB("QUEUE","IN",TRANDATE))
IF 'TRANDATE
QUIT
Begin DoDot:1
+10 SET MSGTYPE=""
+11 FOR
SET MSGTYPE=$ORDER(^HLB("QUEUE","IN",TRANDATE,"RPMS-MPI",MSGTYPE))
IF MSGTYPE=""
QUIT
Begin DoDot:2
+12 SET EVENT=""
+13 FOR
SET EVENT=$ORDER(^HLB("QUEUE","IN",TRANDATE,"RPMS-MPI",MSGTYPE,EVENT))
IF EVENT=""
QUIT
Begin DoDot:3
+14 SET MPIIEN=""
+15 FOR
SET MPIIEN=$ORDER(^HLB("QUEUE","IN",TRANDATE,"RPMS-MPI",MSGTYPE,EVENT,MPIIEN))
IF MPIIEN=""
QUIT
Begin DoDot:4
+16 SET INCOUNT=INCOUNT+1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 SET MPIIEN=""
+18 FOR
SET MPIIEN=$ORDER(^HLB("QUEUE","OUT",MPILINK,"MPI RPMS",MPIIEN))
IF 'MPIIEN
QUIT
Begin DoDot:1
+19 SET OUTCOUNT=OUTCOUNT+1
End DoDot:1
+20 SET MPIIEN=0
+21 FOR
SET MPIIEN=$ORDER(^HLB(MPIIEN))
IF 'MPIIEN
QUIT
Begin DoDot:1
+22 SET LINK=$PIECE($GET(^HLB(MPIIEN,0)),U,5)
+23 IF LINK'="MPI"
QUIT
+24 SET TOTCOUNT=TOTCOUNT+1
End DoDot:1
+25 WRITE !!," MESSAGES IN THE IN QUEUE: ",$JUSTIFY($FNUMBER(INCOUNT,","),9)
+26 WRITE !," MESSAGES IN OUT QUEUE: ",$JUSTIFY($FNUMBER(OUTCOUNT,","),9)
+27 WRITE !,"TOTAL MESSAGES IN HLO GLOBALS: ",$JUSTIFY($FNUMBER(TOTCOUNT,","),9)
+28 IF '$DATA(ZTQUEUED)
Begin DoDot:1
+29 USE 0
+30 WRITE !
+31 KILL DIR
+32 SET DIR(0)="E"
+33 DO ^DIR
+34 SET ESC=X=U
End DoDot:1
IF ESC
QUIT
+35 IF '$DATA(ZTQUEUED)
GOTO QUEVSENT
+36 QUIT
