AGMPHLU2.m

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