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
