ACDRESET ;IHS/ADC/EDE/KML - EXTRACT RESET BY DATE RANGE;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;***********************************************************
;//[ACD SUPER1]
;***********************************************************
EN ;EP
W !!,@IOF,"I will reset all CDMIS extract flags between the to: and from:",!,"dates you give me. Once the extract flags are reset for the records, the",!,"records may be re-extracted for transmission to the AREA or HQ."
W !!,*7,*7,"WARNING.....",!,"THIS MAY CAUSE DUPLICATED ENTRIES IN THE AREA/HQ MACHINE..",!,"COORDINATE THE EXTRACT RESET WITH THE AREA/HEADQUARTERS.."
EN1 ;
K ACDPGM
W !!,"Reset extract flags for all programs" S %=2 D YN^DICN I %=1 F ACDDA=0:0 S ACDDA=$O(^ACDVIS("C",ACDDA)) Q:'ACDDA S ACDPGM(ACDDA)=""
I %=0 W !!,"Answer yes to reset extract flags for 'ALL' programs."
I %=0 W !,"If you answer yes, I will show you a list of programs found."
I %=0 W !,"Answer no, and you may then select individual programs." G EN1
I %=2 F S DIC(0)="AEQ",DIC=4,DIC("A")="SELECT PROGRAM: " D ^DIC Q:Y<0 S ACDPGM(+Y)=""
I '$O(ACDPGM(0)) G K
;
K ACDQUIT D D^ACDWRQ I $D(ACDQUIT) G K
W !!!,"Resetting Extract flags for all CDMIS visit/prevention data"
W !!,"from: ",$$DD^ACDFUNC(ACDFR)," through: "
W $$DD^ACDFUNC(ACDTO),!!,"for Program(s): "
F DA=0:0 S DA=$O(ACDPGM(DA)) Q:'DA W !,$P(^DIC(4,DA,0),U)
F W !!,"OK to continue" S %=2 D YN^DICN W:%=0 " Answer Yes or No" G:%'=1&(%'=0) K Q:%=1
W !!,"Extract flags being re-initialized for VISIT DATA"
F ACD=ACDFR-.01:0 S ACD=$O(^ACDVIS("B",ACD)) Q:'ACD!(ACD>ACDTO) F ACDV=0:0 S ACDV=$O(^ACDVIS("B",ACD,ACDV)) Q:'ACDV W "." D
.I '$D(^ACDVIS(ACDV,0)) Q
.I '$D(^ACDVIS(ACDV,"BWP")) Q
.I '$D(ACDPGM(^ACDVIS(ACDV,"BWP"))) Q
.S DA=ACDV,DIE="^ACDVIS(",DR="25///@" D DIE^ACDFMC
.F ACDDA=0:0 S ACDDA=$O(^ACDIIF("C",ACDV,ACDDA)) Q:'ACDDA S DA=ACDDA,DIE="^ACDIIF(",DR="25///@" D DIE^ACDFMC
.F ACDDA=0:0 S ACDDA=$O(^ACDTDC("C",ACDV,ACDDA)) Q:'ACDDA S DA=ACDDA,DIE="^ACDTDC(",DR="25///@" D DIE^ACDFMC
.F ACDDA=0:0 S ACDDA=$O(^ACDCS("C",ACDV,ACDDA)) Q:'ACDDA S DA=ACDDA,DIE="^ACDCS(",DR="5///@" D DIE^ACDFMC
PRV ;
W !!,"Extract flags being re-initialized for PREVENTION DATA"
F ACD=ACDFR-.001:0 S ACD=$O(^ACDPD("B",ACD)) Q:'ACD!(ACD>ACDTO) F ACDV=0:0 S ACDV=$O(^ACDPD("B",ACD,ACDV)) Q:'ACDV D
.I '$D(^ACDPD(ACDV,0)) Q
.S ACDBWP=$P(^ACDPD(ACDV,0),U,4) Q:'ACDBWP I '$D(ACDPGM(ACDBWP)) Q
.S DA=ACDV,DIE="^ACDPD(",DR="25///@" D DIE^ACDFMC W "."
K ;
K X,Y,ACDFR,ACDTO,DA,DR,DIE,ACDDA,ACD,ACDV,%,ACDPGM
ACDRESET ;IHS/ADC/EDE/KML - EXTRACT RESET BY DATE RANGE;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;***********************************************************
+3 ;//[ACD SUPER1]
+4 ;***********************************************************
EN ;EP
+1 WRITE !!,@IOF,"I will reset all CDMIS extract flags between the to: and from:",!,"dates you give me. Once the extract flags are reset for the records, the",!,"records may be re-extracted for transmission to the AREA or HQ."
+2 WRITE !!,*7,*7,"WARNING.....",!,"THIS MAY CAUSE DUPLICATED ENTRIES IN THE AREA/HQ MACHINE..",!,"COORDINATE THE EXTRACT RESET WITH THE AREA/HEADQUARTERS.."
EN1 ;
+1 KILL ACDPGM
+2 WRITE !!,"Reset extract flags for all programs"
SET %=2
DO YN^DICN
IF %=1
FOR ACDDA=0:0
SET ACDDA=$ORDER(^ACDVIS("C",ACDDA))
IF 'ACDDA
QUIT
SET ACDPGM(ACDDA)=""
+3 IF %=0
WRITE !!,"Answer yes to reset extract flags for 'ALL' programs."
+4 IF %=0
WRITE !,"If you answer yes, I will show you a list of programs found."
+5 IF %=0
WRITE !,"Answer no, and you may then select individual programs."
GOTO EN1
+6 IF %=2
FOR
SET DIC(0)="AEQ"
SET DIC=4
SET DIC("A")="SELECT PROGRAM: "
DO ^DIC
IF Y<0
QUIT
SET ACDPGM(+Y)=""
+7 IF '$ORDER(ACDPGM(0))
GOTO K
+8 ;
+9 KILL ACDQUIT
DO D^ACDWRQ
IF $DATA(ACDQUIT)
GOTO K
+10 WRITE !!!,"Resetting Extract flags for all CDMIS visit/prevention data"
+11 WRITE !!,"from: ",$$DD^ACDFUNC(ACDFR)," through: "
+12 WRITE $$DD^ACDFUNC(ACDTO),!!,"for Program(s): "
+13 FOR DA=0:0
SET DA=$ORDER(ACDPGM(DA))
IF 'DA
QUIT
WRITE !,$PIECE(^DIC(4,DA,0),U)
+14 FOR
WRITE !!,"OK to continue"
SET %=2
DO YN^DICN
IF %=0
WRITE " Answer Yes or No"
IF %'=1&(%'=0)
GOTO K
IF %=1
QUIT
+15 WRITE !!,"Extract flags being re-initialized for VISIT DATA"
+16 FOR ACD=ACDFR-.01:0
SET ACD=$ORDER(^ACDVIS("B",ACD))
IF 'ACD!(ACD>ACDTO)
QUIT
FOR ACDV=0:0
SET ACDV=$ORDER(^ACDVIS("B",ACD,ACDV))
IF 'ACDV
QUIT
WRITE "."
Begin DoDot:1
+17 IF '$DATA(^ACDVIS(ACDV,0))
QUIT
+18 IF '$DATA(^ACDVIS(ACDV,"BWP"))
QUIT
+19 IF '$DATA(ACDPGM(^ACDVIS(ACDV,"BWP")))
QUIT
+20 SET DA=ACDV
SET DIE="^ACDVIS("
SET DR="25///@"
DO DIE^ACDFMC
+21 FOR ACDDA=0:0
SET ACDDA=$ORDER(^ACDIIF("C",ACDV,ACDDA))
IF 'ACDDA
QUIT
SET DA=ACDDA
SET DIE="^ACDIIF("
SET DR="25///@"
DO DIE^ACDFMC
+22 FOR ACDDA=0:0
SET ACDDA=$ORDER(^ACDTDC("C",ACDV,ACDDA))
IF 'ACDDA
QUIT
SET DA=ACDDA
SET DIE="^ACDTDC("
SET DR="25///@"
DO DIE^ACDFMC
+23 FOR ACDDA=0:0
SET ACDDA=$ORDER(^ACDCS("C",ACDV,ACDDA))
IF 'ACDDA
QUIT
SET DA=ACDDA
SET DIE="^ACDCS("
SET DR="5///@"
DO DIE^ACDFMC
End DoDot:1
PRV ;
+1 WRITE !!,"Extract flags being re-initialized for PREVENTION DATA"
+2 FOR ACD=ACDFR-.001:0
SET ACD=$ORDER(^ACDPD("B",ACD))
IF 'ACD!(ACD>ACDTO)
QUIT
FOR ACDV=0:0
SET ACDV=$ORDER(^ACDPD("B",ACD,ACDV))
IF 'ACDV
QUIT
Begin DoDot:1
+3 IF '$DATA(^ACDPD(ACDV,0))
QUIT
+4 SET ACDBWP=$PIECE(^ACDPD(ACDV,0),U,4)
IF 'ACDBWP
QUIT
IF '$DATA(ACDPGM(ACDBWP))
QUIT
+5 SET DA=ACDV
SET DIE="^ACDPD("
SET DR="25///@"
DO DIE^ACDFMC
WRITE "."
End DoDot:1
K ;
+1 KILL X,Y,ACDFR,ACDTO,DA,DR,DIE,ACDDA,ACD,ACDV,%,ACDPGM
