- ACDDFAC ;IHS/ADC/EDE/KML - CLEAN OUT AREA/HQ DB OF FACILITY ENTRIES;
- ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- ;************************************************************
- ;This CDMIS utility runs at the Area or HQ to clean out the
- ;Area or HQ database of facility data by date range. The user
- ;specifies which date range to delete data for, and which facility
- ;to delete. This routine will prep an Area/HQ machine for an upcomming
- ;import from a facility. There will be a need to clean out the
- ;Area/HQ machine prior to importing. This will be the case if a
- ;facility needs to resend data up to the Area. The Area database
- ;must first be cleaned out so not to have duplicate entries.
- ;
- ;Note this utility DOES NOT delete intervention data.
- ;//[ACD SUPER2]
- ;************************************************************
- EN ;EP
- W @IOF,!,*7,*7,*7,"WARNING..This utility will 'PERMANENTLY DELETE' CDMIS DATA."
- W !,"This is not a data archive (the data cannot be retrieved)",!
- W !,"This utility should only be run on machines receiving data imports."
- W !,"This utility should 'NEVER' run at the facility or on an",!,"Area machine where facilities are dialing into the Area to access CDMIS."
- ;
- D EN4^ACDV4MES
- ;
- ;
- ;
- ;
- EN1 ;
- ;Stop user if facility
- I $E(ACD6DIG)'=9,$E(ACD6DIG,3,4)'="00" W !!,*7,*7,"Facilities may not delete data using this option." D K Q
- ;
- K ACDPGM
- ;
- ;Load program names from the CDMIS VISIT file
- ;Load program names from the CDMIS PREVENTION file
- W !!,"Delete data 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 %=1 F ACDDA=0:0 S ACDDA=$O(^ACDPD("C",ACDDA)) Q:'ACDDA S ACDPGM(ACDDA)=""
- I %=0 W !!,"Answer yes to 'PERMANENTLY DELETE DATA' 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
- ;Ask user for dates
- K ACDQUIT D D^ACDWRQ I $D(ACDQUIT) G K
- ;verify user wants to continue
- W !!!,"Deleting CDMIS VISIT ENTRIES for all CDMIS visit/prevention data",!!,"from: ",$$DD^ACDFUNC(ACDFR)," through: ",$$DD^ACDFUNC(ACDTO),!!,"for Program(s): " F DA=0:0 S DA=$O(ACDPGM(DA)) Q:'DA W !,$P(^DIC(4,DA,0),U)
- ;
- W !!!,*7,*7,"Your last chance to quit without deleting data is NOW !!??"
- W !!
- F W !!,"OK to continue" S %=2 D YN^DICN W:%=0 " Answer Yes or No" G:%'=1&(%'=0) K Q:%=1
- W !!,"First let me break the Visit Links....."
- F ACDAT=ACDFR-.01:0 S ACDAT=$O(^ACDVIS("B",ACDAT)) Q:'ACDAT!(ACDAT>ACDTO) F DA=0:0 S DA=$O(^ACDVIS("B",ACDAT,DA)) Q:'DA I $D(^ACDVIS(DA,0)),$D(^ACDVIS(DA,"BWP")),$D(ACDPGM(^("BWP"))) S DIK="^ACDVIS(" D ^DIK
- D EN1^ACDCLN
- F ACDAT=ACDFR-.01:0 S ACDAT=$O(^ACDPD("B",ACDAT)) Q:'ACDAT!(ACDAT>ACDTO) F DA=0:0 S DA=$O(^ACDPD("B",ACDAT,DA)) Q:'DA I $D(^ACDPD(DA,0)),$D(ACDPGM($P(^(0),U,4))) S DIK="^ACDPD(" D ^DIK
- K ;
- K DIC,DIK,DA,ACDPGM,Y,ACDTO,ACDFR
- K ACDAT
- Q
- ACDDFAC ;IHS/ADC/EDE/KML - CLEAN OUT AREA/HQ DB OF FACILITY ENTRIES;
- +1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
- +2 ;************************************************************
- +3 ;This CDMIS utility runs at the Area or HQ to clean out the
- +4 ;Area or HQ database of facility data by date range. The user
- +5 ;specifies which date range to delete data for, and which facility
- +6 ;to delete. This routine will prep an Area/HQ machine for an upcomming
- +7 ;import from a facility. There will be a need to clean out the
- +8 ;Area/HQ machine prior to importing. This will be the case if a
- +9 ;facility needs to resend data up to the Area. The Area database
- +10 ;must first be cleaned out so not to have duplicate entries.
- +11 ;
- +12 ;Note this utility DOES NOT delete intervention data.
- +13 ;//[ACD SUPER2]
- +14 ;************************************************************
- EN ;EP
- +1 WRITE @IOF,!,*7,*7,*7,"WARNING..This utility will 'PERMANENTLY DELETE' CDMIS DATA."
- +2 WRITE !,"This is not a data archive (the data cannot be retrieved)",!
- +3 WRITE !,"This utility should only be run on machines receiving data imports."
- +4 WRITE !,"This utility should 'NEVER' run at the facility or on an",!,"Area machine where facilities are dialing into the Area to access CDMIS."
- +5 ;
- +6 DO EN4^ACDV4MES
- +7 ;
- +8 ;
- +9 ;
- +10 ;
- EN1 ;
- +1 ;Stop user if facility
- +2 IF $EXTRACT(ACD6DIG)'=9
- IF $EXTRACT(ACD6DIG,3,4)'="00"
- WRITE !!,*7,*7,"Facilities may not delete data using this option."
- DO K
- QUIT
- +3 ;
- +4 KILL ACDPGM
- +5 ;
- +6 ;Load program names from the CDMIS VISIT file
- +7 ;Load program names from the CDMIS PREVENTION file
- +8 WRITE !!,"Delete data 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)=""
- +9 IF %=1
- FOR ACDDA=0:0
- SET ACDDA=$ORDER(^ACDPD("C",ACDDA))
- IF 'ACDDA
- QUIT
- SET ACDPGM(ACDDA)=""
- +10 IF %=0
- WRITE !!,"Answer yes to 'PERMANENTLY DELETE DATA' for 'ALL' programs."
- +11 IF %=0
- WRITE !,"If you answer yes, I will show you a list of programs found."
- +12 IF %=0
- WRITE !,"Answer no, and you may then select individual programs."
- GOTO EN1
- +13 IF %=2
- FOR
- SET DIC(0)="AEQ"
- SET DIC=4
- SET DIC("A")="SELECT PROGRAM: "
- DO ^DIC
- IF Y<0
- QUIT
- SET ACDPGM(+Y)=""
- +14 IF '$ORDER(ACDPGM(0))
- GOTO K
- +15 ;Ask user for dates
- +16 KILL ACDQUIT
- DO D^ACDWRQ
- IF $DATA(ACDQUIT)
- GOTO K
- +17 ;verify user wants to continue
- +18 WRITE !!!,"Deleting CDMIS VISIT ENTRIES for all CDMIS visit/prevention data",!!,"from: ",$$DD^ACDFUNC(ACDFR)," through: ",$$DD^ACDFUNC(ACDTO),!!,"for Program(s): "
- FOR DA=0:0
- SET DA=$ORDER(ACDPGM(DA))
- IF 'DA
- QUIT
- WRITE !,$PIECE(^DIC(4,DA,0),U)
- +19 ;
- +20 WRITE !!!,*7,*7,"Your last chance to quit without deleting data is NOW !!??"
- +21 WRITE !!
- +22 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
- +23 WRITE !!,"First let me break the Visit Links....."
- +24 FOR ACDAT=ACDFR-.01:0
- SET ACDAT=$ORDER(^ACDVIS("B",ACDAT))
- IF 'ACDAT!(ACDAT>ACDTO)
- QUIT
- FOR DA=0:0
- SET DA=$ORDER(^ACDVIS("B",ACDAT,DA))
- IF 'DA
- QUIT
- IF $DATA(^ACDVIS(DA,0))
- IF $DATA(^ACDVIS(DA,"BWP"))
- IF $DATA(ACDPGM(^("BWP")))
- SET DIK="^ACDVIS("
- DO ^DIK
- +25 DO EN1^ACDCLN
- +26 FOR ACDAT=ACDFR-.01:0
- SET ACDAT=$ORDER(^ACDPD("B",ACDAT))
- IF 'ACDAT!(ACDAT>ACDTO)
- QUIT
- FOR DA=0:0
- SET DA=$ORDER(^ACDPD("B",ACDAT,DA))
- IF 'DA
- QUIT
- IF $DATA(^ACDPD(DA,0))
- IF $DATA(ACDPGM($PIECE(^(0),U,4)))
- SET DIK="^ACDPD("
- DO ^DIK
- K ;
- +1 KILL DIC,DIK,DA,ACDPGM,Y,ACDTO,ACDFR
- +2 KILL ACDAT
- +3 QUIT
