- 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
