AGTXPERK ; IHS/ASDS/EFG - SCAN AND KILL PAST TX ERRORS ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;Past Error Killer
S ;SELECT DATES
W !,"You will be able to select",!?5,"a range of dates",!?5,"a range of errors",!,"to be deleted.",!!
DT1 S %DT="AEX",%DT(0)="-NOW",%DT("A")="START Date (or ^) " D ^%DT
I Y'>0 G EXIT
S AGSDT=Y
DT2 S %DT="AEX",%DT(0)=AGSDT,%DT("A")="END Date (or ^) " D ^%DT
I Y'>0 G DT1
S AGEDT=Y
K %DT(0)
D DDISP
K AG D VAR^AGBADATA
W !,"Select Records-Errors to be deleted.",!,"Records with the errors selected will be removed from transmissions.",!!
F AGI=1:1 Q:'$D(AG(AGI)) W !,AGI,?5,AG(AGI)
S AGI=AGI-1
W !
K DIR S DIR(0)="L^1:"_AGI,DIR("A")="Select Errors to be deleted: " D ^DIR
S AGER=Y I '+AGER W !,"NO ERRORS SELECTED - quiting",! H 3 G EXIT
F AGI=1:1 S AGERSUB=$P(AGER,",",AGI) Q:'AGERSUB S AGER(AGERSUB)=""
D DDISP
D ERDISP
K DIR S DIR(0)="Y",DIR("A")="Are the above selections correct ? ",DIR("B")="Y" D ^DIR
I Y'=1 G S
S XBRC="SCAN^AGTXPERK",XBRP="PRINT^AGTXPERK",XBNS="AG",XBRX="EXIT^AGTXPERK" D ^XBDBQUE
Q
;--------------------------- SUB ROUTINES ------------------
DDISP ;display selection
W !!,"Start Date :",?15 S Y=AGSDT D DD^%DT W Y
W !,"End Date :",?15 S Y=AGEDT D DD^%DT W Y
Q
;--------------------------- SUB ROUTINES ------------------
ERDISP ;display errors selected
K AG D VAR^AGBADATA
F AGI=1:1 S AGE=$P(AGER,",",AGI) Q:'AGE W !?5,AGE,?10,AG(AGE)
W !
Q
;--------------------------- SUB ROUTINES ------------------
SCAN ;scan all past errors
S AGDTS=AGSDT,AGEDT=AGEDT+1,AGCNT=0
F S AGDTS=$O(^AGPATCH("ER",AGDTS)) Q:((AGDTS>AGEDT)!(AGDTS="")) S AGSITE="" F S AGSITE=$O(^AGPATCH("ER",AGDTS,AGSITE)) Q:AGSITE="" S AGDFN="" F S AGDFN=$O(^AGPATCH("ER",AGDTS,AGSITE,AGDFN)) Q:AGDFN="" D
.I $P(^DPT(AGDFN,0),"^",19)>0 K ^AGPATCH("ER",AGDTS,AGSITE,AGDFN) Q ;merged patient
.S DFN=AGDFN K AG D ^AGDATCK
.S AGI="",AGK=0 F S AGI=$O(AGER(AGI)) Q:AGI="" I $D(AG("ER",AGI)) D Q
..S AGCNT=AGCNT+1
..K ^AGPATCH("ER",AGDTS,AGSITE,AGDFN)
Q
;--------------------------- SUB ROUTINES ------------------
PRINT ;Print Completion
W !,"PAST ERRORS REMOVED REPORT",!
D DDISP,ERDISP
W !,AGCNT,?10,"Transmission sends deleted",!!
I IO=IO(0),'$D(ZTQUEUED) K DIR S DIR(0)="E" D ^DIR
W $$S^AGVDF("IOF")
Q
;--------------------------- SUB ROUTINES ------------------
EXIT ;CLEAN UP
S AG="AG" F S AG=$O(@AG) Q:$E(AG,1,2)'="AG" K @AG
K AG
Q
AGTXPERK ; IHS/ASDS/EFG - SCAN AND KILL PAST TX ERRORS ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;Past Error Killer
S ;SELECT DATES
+1 WRITE !,"You will be able to select",!?5,"a range of dates",!?5,"a range of errors",!,"to be deleted.",!!
DT1 SET %DT="AEX"
SET %DT(0)="-NOW"
SET %DT("A")="START Date (or ^) "
DO ^%DT
+1 IF Y'>0
GOTO EXIT
+2 SET AGSDT=Y
DT2 SET %DT="AEX"
SET %DT(0)=AGSDT
SET %DT("A")="END Date (or ^) "
DO ^%DT
+1 IF Y'>0
GOTO DT1
+2 SET AGEDT=Y
+3 KILL %DT(0)
+4 DO DDISP
+5 KILL AG
DO VAR^AGBADATA
+6 WRITE !,"Select Records-Errors to be deleted.",!,"Records with the errors selected will be removed from transmissions.",!!
+7 FOR AGI=1:1
IF '$DATA(AG(AGI))
QUIT
WRITE !,AGI,?5,AG(AGI)
+8 SET AGI=AGI-1
+9 WRITE !
+10 KILL DIR
SET DIR(0)="L^1:"_AGI
SET DIR("A")="Select Errors to be deleted: "
DO ^DIR
+11 SET AGER=Y
IF '+AGER
WRITE !,"NO ERRORS SELECTED - quiting",!
HANG 3
GOTO EXIT
+12 FOR AGI=1:1
SET AGERSUB=$PIECE(AGER,",",AGI)
IF 'AGERSUB
QUIT
SET AGER(AGERSUB)=""
+13 DO DDISP
+14 DO ERDISP
+15 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Are the above selections correct ? "
SET DIR("B")="Y"
DO ^DIR
+16 IF Y'=1
GOTO S
+17 SET XBRC="SCAN^AGTXPERK"
SET XBRP="PRINT^AGTXPERK"
SET XBNS="AG"
SET XBRX="EXIT^AGTXPERK"
DO ^XBDBQUE
+18 QUIT
+19 ;--------------------------- SUB ROUTINES ------------------
DDISP ;display selection
+1 WRITE !!,"Start Date :",?15
SET Y=AGSDT
DO DD^%DT
WRITE Y
+2 WRITE !,"End Date :",?15
SET Y=AGEDT
DO DD^%DT
WRITE Y
+3 QUIT
+4 ;--------------------------- SUB ROUTINES ------------------
ERDISP ;display errors selected
+1 KILL AG
DO VAR^AGBADATA
+2 FOR AGI=1:1
SET AGE=$PIECE(AGER,",",AGI)
IF 'AGE
QUIT
WRITE !?5,AGE,?10,AG(AGE)
+3 WRITE !
+4 QUIT
+5 ;--------------------------- SUB ROUTINES ------------------
SCAN ;scan all past errors
+1 SET AGDTS=AGSDT
SET AGEDT=AGEDT+1
SET AGCNT=0
+2 FOR
SET AGDTS=$ORDER(^AGPATCH("ER",AGDTS))
IF ((AGDTS>AGEDT)!(AGDTS=""))
QUIT
SET AGSITE=""
FOR
SET AGSITE=$ORDER(^AGPATCH("ER",AGDTS,AGSITE))
IF AGSITE=""
QUIT
SET AGDFN=""
FOR
SET AGDFN=$ORDER(^AGPATCH("ER",AGDTS,AGSITE,AGDFN))
IF AGDFN=""
QUIT
Begin DoDot:1
+3 ;merged patient
IF $PIECE(^DPT(AGDFN,0),"^",19)>0
KILL ^AGPATCH("ER",AGDTS,AGSITE,AGDFN)
QUIT
+4 SET DFN=AGDFN
KILL AG
DO ^AGDATCK
+5 SET AGI=""
SET AGK=0
FOR
SET AGI=$ORDER(AGER(AGI))
IF AGI=""
QUIT
IF $DATA(AG("ER",AGI))
Begin DoDot:2
+6 SET AGCNT=AGCNT+1
+7 KILL ^AGPATCH("ER",AGDTS,AGSITE,AGDFN)
End DoDot:2
QUIT
End DoDot:1
+8 QUIT
+9 ;--------------------------- SUB ROUTINES ------------------
PRINT ;Print Completion
+1 WRITE !,"PAST ERRORS REMOVED REPORT",!
+2 DO DDISP
DO ERDISP
+3 WRITE !,AGCNT,?10,"Transmission sends deleted",!!
+4 IF IO=IO(0)
IF '$DATA(ZTQUEUED)
KILL DIR
SET DIR(0)="E"
DO ^DIR
+5 WRITE $$S^AGVDF("IOF")
+6 QUIT
+7 ;--------------------------- SUB ROUTINES ------------------
EXIT ;CLEAN UP
+1 SET AG="AG"
FOR
SET AG=$ORDER(@AG)
IF $EXTRACT(AG,1,2)'="AG"
QUIT
KILL @AG
+2 KILL AG
+3 QUIT
