- 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
