AGMPPURG.m

AGMPPURG ; IHS/SD/TPF - MPI HLO MESSAGE PURGE

 ;;7.2;IHS PATIENT REGISTRATION;**1,6**;JAN 07, 2011;Build 23

 Q

 ;

 ;NOT FINISHED

INTERACT ;EP - USER INTERACTIVE PURGE

 N ONLYSUC,ONLYFAIL,ONLYADT,ONLYACK,ONLYA28,ONLYA08

 N ONLYMFN,ONLYMFK

 Q

 ;

PURGE  ;EP PURGE MPI HL7 MESSAGES OLDER THAN 7DAYS

 ;

 N MPIIEN,MPIIEN2,MPIDATE,MPIDT1,MPIDAYS,MPITYPE,QUIT

 N GRDTOTAL,EVENTTOT,DIRECTOT,MSGTYPTO,ACKCODET,STATUSTO

 S (GRDTOTAL,EVENTTOT,DIRECTOT,MSGTYPTO,STATUSTO)=0

 S (MPIIEN,MPIIEN2,QUIT)=0

 S MPIDAYS=$$GET1^DIQ(9009061,DUZ(2)_",",2202)  ;DAYS TO KEEP MPI HLO MESSAGES

 S:MPIDAYS="" MPIDAYS=7

 S X="T-"_MPIDAYS D ^%DT S PURGDT=Y

 ;B "S+"

 ;S PURGDT=3100804

 F  S MPIIEN=$O(^HLB(MPIIEN)) Q:'MPIIEN!(QUIT)  D

 .S LINK=$P($G(^HLB(MPIIEN,0)),U,5)

 .Q:LINK'="MPI"

 .S MPIDIREC=$P($G(^HLB(MPIIEN,0)),U,4)   ;DIRECTION INCOMING DO NOT HAVE A COMPLETION STATUS

 .S COMSTAT=$P($G(^HLB(MPIIEN,0)),U,20)  ;COMPLETION STATUS

 .S SCHEDPUR=$P($G(^HLB(MPIIEN,0)),U,9)  ;SCHEDULED PURGE

 .S MSGBOD=$P($G(^HLB(MPIIEN,0)),U,2)  ;MESSAGE BODY

 .S MSGTYPE=$P($G(^HLA(MSGBOD,0)),U,3)  ;MESSAGE TYPE

 .S EVENT=$P($G(^HLA(MSGBOD,0)),U,4)  ;EVENT

 .I COMSTAT'="SU" Q

 .S TRANDATE=$P($G(^HLB(MPIIEN,0)),U,16)  ;TRANSMISSION DATE/TIME

 .S MSGID=$P($G(^HLB(MPIIEN,0)),U)   ;MESSAGE ID

 .S ACKCODE=$P($G(^HLA(MSGID,1,1,0)),U,2)

 .;B "S+"

 .I $G(TRANDATE)>(PURGDT) S QUIT=1 Q

 .S GRDTOTAL=GRDTOTAL+1

 .S:EVENT'="" EVENTTOT(EVENT)=$G(EVENTTOT(EVENT))+1

 .S:MPIDIREC'="" DIRECTOT(MPIDIREC)=$G(DIRECTOT(MPIDIREC))+1

 .S:MSGTYPE'="" MSGTYPTO(MSGTYPE)=$G(MSGTYPTO(MSGTYPE))+1

 .S:ACKCODE'="" ACKCODET(ACKCODE)=$G(ACKCODET(ACKCODE))+1

 .S COMSTAT=$S(COMSTAT'="":COMSTAT,1:"UNDEF")

 .S STATUSTO=$G(STATUSTO(COMSTAT))+1

 .I '$D(ZTQUEUED) D

 ..W !!,"TRANDATE: ",TRANDATE

 ..W !,"PURGE: ",MPIIEN

 ..W !,"MPIDIREC: ",MPIDIREC

 ..W !,"MSG TYPE: ",MSGTYPE

 ..W !,"EVENT: ",EVENT

 ..W !,"ACKCODE: ",ACKCODE

 .;B:SCHEDPUR="" "S+"

 .S DA=MPIIEN,DIK="^HLB(" D ^DIK

 .S DA=MSGBOD,DIK="^HLA(" D ^DIK

 .D AC(MPIIEN,MSGID)  ;CLEAN UP FOR HLB

 .I MPIDIREC="I" D ADI,QUEUEI Q

 .I MPIDIREC="O" D ADO(SCHEDPUR),QUEUEO

 I '$D(ZTQUEUED) D PRINT

 Q

 ;USE TO CLEAN UP BODIES W/O HEADERS. RESET HLC

SELKILL ;EP

 ; 9/08/2017 - GCD - CR 7705 - Disabled this because it can delete data for any HLO application, not just MPI, among other issues.

 Q

 ;

 S IEN=0 F CNT=1:1 S IEN=$O(^HLA(IEN)) Q:IEN=""  D

 .Q:$D(^HLB(IEN))

 .S DA=IEN,DIK="^HLA(" D ^DIK

 .W "."

 S ^HLC("FILE777","OUT")=BEGIN

 S ^HLC("FILE778","OUT","TCP")=BEGIN

 Q

 ;

PRINT ;EP - PRINT COUNTS

 N EVENT,MPIDIREC,MSGTYPE,ACKCODE

 S EVENT=""

 F  S EVENT=$O(EVENTTOT(EVENT)) Q:EVENT=""  W !,"EVENT: ",EVENT,?25,EVENTTOT(EVENT)

 S MPIDIREC=""

 F  S MPIDIREC=$O(DIRECTOT(MPIDIREC)) Q:MPIDIREC=""  W !,"DIRECTION: ",MPIDIREC,?25,DIRECTOT(MPIDIREC)

 S MSGTYPE=""

 F  S MSGTYPE=$O(MSGTYPTO(MSGTYPE)) Q:MSGTYPE=""  W !,"MSG TYPE: ",MSGTYPE,?25,MSGTYPTO(MSGTYPE)

 S ACKCODE=""

 F  S ACKCODE=$O(ACKCODET(ACKCODE)) Q:ACKCODE=""  W !,"ACK CODE: ",ACKCODE,?25,ACKCODET(ACKCODE)

 W !,"GRAND TOT PURGED: ",GRDTOTAL

 Q

 ;

AC(MPIIEN,MSGID) ;DELETE "AC" XREF FOR IEN

 ;MPI EXAMPLE:HLB("AC","8990MPI14752 26",26)=

 ;STATION # MPI = 8990

 ;HL LOGICAL LINK = MPI

 ;MSG ID = 14752 26

 K ^HLB("AC",MSGID,MPIIEN)

 S CMP="8990MPI"_MSGID

 K ^HLB("AC",CMP,MPIIEN)

 Q

ADI ;DELETE "AD" XREF FOR "IN" IEN

 K ^HLB("AD","IN",MPIIEN)

 Q

ADO(SCHEDPUR) ;DELETE "AD" XREF FOR "OUT" IEN

 Q:$G(SCHEDPUR)=""

 ;EXAMPLE:  ^HLB("AD","OUT",3090819.1143,3)=""

 K ^HLB("AD","OUT",SCHEDPUR,MPIIEN)

 Q

QUEUEI ;DELETE "QUEUE" XREF FOR IEN

 ;EXAMPLE: ^HLB("QUEUE","IN",3100611.0903,"RPMS-MPI","ACK","A28",42)

 K ^HLB("QUEUE","IN",TRANDATE,"RPMS-MPI",MSGTYPE,EVENT,MPIIEN)

 Q

QUEUEO ;DELETE "QUEUE" XREF FOR IEN

 ;EXAMPLE: ^HLB("QUEUE","OUT","MPI:8899","MPI RPMS",41)=

 N HLOG,PORT,MPILINK,REC

 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

 K ^HLB("QUEUE","OUT",MPILINK,"MPI RPMS",MPIIEN)

 Q

AGMPPURG  ; IHS/SD/TPF - MPI HLO MESSAGE PURGE

 +1       ;;7.2;IHS PATIENT REGISTRATION;**1,6**;JAN 07, 2011;Build 23

 +2        QUIT 

 +3       ;

 +4       ;NOT FINISHED

INTERACT  ;EP - USER INTERACTIVE PURGE

 +1        NEW ONLYSUC,ONLYFAIL,ONLYADT,ONLYACK,ONLYA28,ONLYA08

 +2        NEW ONLYMFN,ONLYMFK

 +3        QUIT 

 +4       ;

PURGE     ;EP PURGE MPI HL7 MESSAGES OLDER THAN 7DAYS

 +1       ;

 +2        NEW MPIIEN,MPIIEN2,MPIDATE,MPIDT1,MPIDAYS,MPITYPE,QUIT

 +3        NEW GRDTOTAL,EVENTTOT,DIRECTOT,MSGTYPTO,ACKCODET,STATUSTO

 +4        SET (GRDTOTAL,EVENTTOT,DIRECTOT,MSGTYPTO,STATUSTO)=0

 +5        SET (MPIIEN,MPIIEN2,QUIT)=0

 +6       ;DAYS TO KEEP MPI HLO MESSAGES

           SET MPIDAYS=$$GET1^DIQ(9009061,DUZ(2)_",",2202)

 +7        IF MPIDAYS=""

               SET MPIDAYS=7

 +8        SET X="T-"_MPIDAYS

           DO ^%DT

           SET PURGDT=Y

 +9       ;B "S+"

 +10      ;S PURGDT=3100804

 +11       FOR 

               SET MPIIEN=$ORDER(^HLB(MPIIEN))

               IF 'MPIIEN!(QUIT)

                   QUIT 

               Begin DoDot:1

 +12               SET LINK=$PIECE($GET(^HLB(MPIIEN,0)),U,5)

 +13               IF LINK'="MPI"

                       QUIT 

 +14      ;DIRECTION INCOMING DO NOT HAVE A COMPLETION STATUS

                   SET MPIDIREC=$PIECE($GET(^HLB(MPIIEN,0)),U,4)

 +15      ;COMPLETION STATUS

                   SET COMSTAT=$PIECE($GET(^HLB(MPIIEN,0)),U,20)

 +16      ;SCHEDULED PURGE

                   SET SCHEDPUR=$PIECE($GET(^HLB(MPIIEN,0)),U,9)

 +17      ;MESSAGE BODY

                   SET MSGBOD=$PIECE($GET(^HLB(MPIIEN,0)),U,2)

 +18      ;MESSAGE TYPE

                   SET MSGTYPE=$PIECE($GET(^HLA(MSGBOD,0)),U,3)

 +19      ;EVENT

                   SET EVENT=$PIECE($GET(^HLA(MSGBOD,0)),U,4)

 +20               IF COMSTAT'="SU"

                       QUIT 

 +21      ;TRANSMISSION DATE/TIME

                   SET TRANDATE=$PIECE($GET(^HLB(MPIIEN,0)),U,16)

 +22      ;MESSAGE ID

                   SET MSGID=$PIECE($GET(^HLB(MPIIEN,0)),U)

 +23               SET ACKCODE=$PIECE($GET(^HLA(MSGID,1,1,0)),U,2)

 +24      ;B "S+"

 +25               IF $GET(TRANDATE)>(PURGDT)

                       SET QUIT=1

                       QUIT 

 +26               SET GRDTOTAL=GRDTOTAL+1

 +27               IF EVENT'=""

                       SET EVENTTOT(EVENT)=$GET(EVENTTOT(EVENT))+1

 +28               IF MPIDIREC'=""

                       SET DIRECTOT(MPIDIREC)=$GET(DIRECTOT(MPIDIREC))+1

 +29               IF MSGTYPE'=""

                       SET MSGTYPTO(MSGTYPE)=$GET(MSGTYPTO(MSGTYPE))+1

 +30               IF ACKCODE'=""

                       SET ACKCODET(ACKCODE)=$GET(ACKCODET(ACKCODE))+1

 +31               SET COMSTAT=$SELECT(COMSTAT'="":COMSTAT,1:"UNDEF")

 +32               SET STATUSTO=$GET(STATUSTO(COMSTAT))+1

 +33               IF '$DATA(ZTQUEUED)

                       Begin DoDot:2

 +34                       WRITE !!,"TRANDATE: ",TRANDATE

 +35                       WRITE !,"PURGE: ",MPIIEN

 +36                       WRITE !,"MPIDIREC: ",MPIDIREC

 +37                       WRITE !,"MSG TYPE: ",MSGTYPE

 +38                       WRITE !,"EVENT: ",EVENT

 +39                       WRITE !,"ACKCODE: ",ACKCODE

                       End DoDot:2

 +40      ;B:SCHEDPUR="" "S+"

 +41               SET DA=MPIIEN

                   SET DIK="^HLB("

                   DO ^DIK

 +42               SET DA=MSGBOD

                   SET DIK="^HLA("

                   DO ^DIK

 +43      ;CLEAN UP FOR HLB

                   DO AC(MPIIEN,MSGID)

 +44               IF MPIDIREC="I"

                       DO ADI

                       DO QUEUEI

                       QUIT 

 +45               IF MPIDIREC="O"

                       DO ADO(SCHEDPUR)

                       DO QUEUEO

               End DoDot:1

 +46       IF '$DATA(ZTQUEUED)

               DO PRINT

 +47       QUIT 

 +48      ;USE TO CLEAN UP BODIES W/O HEADERS. RESET HLC

SELKILL   ;EP

 +1       ; 9/08/2017 - GCD - CR 7705 - Disabled this because it can delete data for any HLO application, not just MPI, among other issues.

 +2        QUIT 

 +3       ;

 +4        SET IEN=0

           FOR CNT=1:1

               SET IEN=$ORDER(^HLA(IEN))

               IF IEN=""

                   QUIT 

               Begin DoDot:1

 +5                IF $DATA(^HLB(IEN))

                       QUIT 

 +6                SET DA=IEN

                   SET DIK="^HLA("

                   DO ^DIK

 +7                WRITE "."

               End DoDot:1

 +8        SET ^HLC("FILE777","OUT")=BEGIN

 +9        SET ^HLC("FILE778","OUT","TCP")=BEGIN

 +10       QUIT 

 +11      ;

PRINT     ;EP - PRINT COUNTS

 +1        NEW EVENT,MPIDIREC,MSGTYPE,ACKCODE

 +2        SET EVENT=""

 +3        FOR 

               SET EVENT=$ORDER(EVENTTOT(EVENT))

               IF EVENT=""

                   QUIT 

               WRITE !,"EVENT: ",EVENT,?25,EVENTTOT(EVENT)

 +4        SET MPIDIREC=""

 +5        FOR 

               SET MPIDIREC=$ORDER(DIRECTOT(MPIDIREC))

               IF MPIDIREC=""

                   QUIT 

               WRITE !,"DIRECTION: ",MPIDIREC,?25,DIRECTOT(MPIDIREC)

 +6        SET MSGTYPE=""

 +7        FOR 

               SET MSGTYPE=$ORDER(MSGTYPTO(MSGTYPE))

               IF MSGTYPE=""

                   QUIT 

               WRITE !,"MSG TYPE: ",MSGTYPE,?25,MSGTYPTO(MSGTYPE)

 +8        SET ACKCODE=""

 +9        FOR 

               SET ACKCODE=$ORDER(ACKCODET(ACKCODE))

               IF ACKCODE=""

                   QUIT 

               WRITE !,"ACK CODE: ",ACKCODE,?25,ACKCODET(ACKCODE)

 +10       WRITE !,"GRAND TOT PURGED: ",GRDTOTAL

 +11       QUIT 

 +12      ;

AC(MPIIEN,MSGID) ;DELETE "AC" XREF FOR IEN

 +1       ;MPI EXAMPLE:HLB("AC","8990MPI14752 26",26)=

 +2       ;STATION # MPI = 8990

 +3       ;HL LOGICAL LINK = MPI

 +4       ;MSG ID = 14752 26

 +5        KILL ^HLB("AC",MSGID,MPIIEN)

 +6        SET CMP="8990MPI"_MSGID

 +7        KILL ^HLB("AC",CMP,MPIIEN)

 +8        QUIT 

ADI       ;DELETE "AD" XREF FOR "IN" IEN

 +1        KILL ^HLB("AD","IN",MPIIEN)

 +2        QUIT 

ADO(SCHEDPUR) ;DELETE "AD" XREF FOR "OUT" IEN

 +1        IF $GET(SCHEDPUR)=""

               QUIT 

 +2       ;EXAMPLE:  ^HLB("AD","OUT",3090819.1143,3)=""

 +3        KILL ^HLB("AD","OUT",SCHEDPUR,MPIIEN)

 +4        QUIT 

QUEUEI    ;DELETE "QUEUE" XREF FOR IEN

 +1       ;EXAMPLE: ^HLB("QUEUE","IN",3100611.0903,"RPMS-MPI","ACK","A28",42)

 +2        KILL ^HLB("QUEUE","IN",TRANDATE,"RPMS-MPI",MSGTYPE,EVENT,MPIIEN)

 +3        QUIT 

QUEUEO    ;DELETE "QUEUE" XREF FOR IEN

 +1       ;EXAMPLE: ^HLB("QUEUE","OUT","MPI:8899","MPI RPMS",41)=

 +2        NEW HLOG,PORT,MPILINK,REC

 +3       ;MPI LOGICAL LINK

           SET HLOG=$ORDER(^HLCS(870,"B","MPI",""))

 +4       ;TCP/IP PORT (OPTIMIZED)

           SET PORT=$$GET1^DIQ(870,HLOG_",",400.08,"E")

 +5        SET MPILINK="MPI:"_PORT

 +6        KILL ^HLB("QUEUE","OUT",MPILINK,"MPI RPMS",MPIIEN)

 +7        QUIT