ACDPDA ;IHS/ADC/EDE/KML - DATA ENTRY/EDIT/DELETE FOR PREVENTION;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
EN ;Add prevention days
;//[ACD 1PSADD]
W @IOF,"Signon Program is : ",$P(^DIC(4,DUZ(2),0),U)
W !,"Records that may be added are: THOSE WITHIN YOUR SIGNIN PROGRAM.",!
W !,"ADDING CDMIS PREVENTION RECORDS...",!!
K ACDVISP S DIC("DR")=""
S DIE="^ACDF5PI("
K DTOUT S DR="[ACD PREVENTION DAY]",DIE("NO^")="BACK",DA=DUZ(2) D ^DIE K DIE,DIC,DR,DA I $D(DTOUT)!('$D(ACDVISP)) D CHK G K
; Above input template shifts to the CDMIS PREVENTION file and does
; a forced add. No lock required.
;
EN1 ;ASK DAYS OVER AND OVER
K ACDM,X
K DIR,X,Y S DIR(0)="9002170.75,.01" D ^DIR G:X["^"!($D(DTOUT))!(X="") CHK S ACDM(1)=Y
K DIR,X,Y S DIR(0)="P^9002170.9:AEQM" D ^DIR G:X["^"!($D(DTOUT)) CHK S ACDM(2)=+Y
K DIR,X,Y S DIR(0)="P^9002170.8:AEQM" D ^DIR G:X["^"!($D(DTOUT)) CHK S ACDM(3)=+Y
K DIR,X,Y S DIR(0)="9002170.75,3" D ^DIR G:X["^"!($D(DTOUT)) CHK S ACDM(4)=Y
K DIR,X,Y S DIR(0)="9002170.75,4" D ^DIR G:X["^"!($D(DTOUT)) CHK S ACDM(5)=Y
K DIR,X,Y S DIR(0)="9002170.75,5" D ^DIR G:X["^"!($D(DTOUT)) CHK S ACDM(6)=Y
K DIR,X,Y S DIR(0)="9002170.75,8" D ^DIR G:X["^"!($D(DTOUT)) CHK S ACDM(7)=Y
F ACDLP=1:1:7 I '$D(ACDM(ACDLP)) D CHK G K
;
S DA(1)=ACDVISP
S DIC="^ACDPD("_DA(1)_",1,",DIE=DIC
I '$D(@(DIC_"0)")) S @(DIC_"0)")="^9002170.75AI"
S X=ACDM(1)
S DIC("DR")="1////"_ACDM(2)_";2////"_ACDM(3)_";3////"_ACDM(4)_";4////"_ACDM(5)_";5////"_ACDM(6)_";8////"_ACDM(7)
S DIC(0)="L"
D FILE^ACDFMC
;
PV ;
;Ask user for secondary providers
S DA(1)=ACDVISP
S DIE="^ACDPD("_DA(1)_",1,"
S DA=+Y,DR=6,DIE("NO^")="BACK" D DIE^ACDFMC
;
W !,"Day entry filed......" D K
W !! G EN1
;
EN2 ;EP Edit Prevention days
;//[ACD 1PSEDIT]
W @IOF,"Signon Program is : ",$P(^DIC(4,DUZ(2),0),U)
W !,"Editable Records are: THOSE NOT EXTRACTED."
W !," THOSE WITHIN YOUR SIGNIN PROGRAM.",!
W !,"EDITING CDMIS PREVENTION RECORDS...",!!
S DIE="^ACDF5PI(",DA=DUZ(2),DR="[ACD PREVENTION EDIT]" D ^DIE
L
G CHK
;
CHK ;Check for valid entry
Q:'$D(ACDVISP)
I $D(^ACDPD(+ACDVISP,0)),'$O(^ACDPD(+ACDVISP,1,0)) D DEL
I $D(ACDVISP),$D(^ACDPD(+ACDVISP,0)) F D CHK2 Q:ACDQ
S ACDQ=0
I $D(ACDM) G K
Q
;
CHK2 ;Allow display/edit
S ACDQ=1
W !!,"You may now display or edit the CDMIS PREVENTION record just created or edited."
S DIR(0)="S^0:Continue;1:Display record;2:Edit record" S DIR("B")="0" K DA D ^DIR K DIR
S ACDY=Y
Q:'ACDY
W !
I ACDY=1 S DIC="^ACDPD(",DA=+ACDVISP,ACDQ=0 K DR D DIQ^ACDFMC,PAUSE^ACDDEU Q
; must be 2 edit
S DIE="^ACDPD(",DA=+ACDVISP,DR="[ACD PREVENTION EDIT]"
D DIE^ACDFMC
S ACDQ=0
Q
;
DEL ;Delete incomplete/incorrect entries
Q:'$D(ACDVISP)
S:'$D(ACDH(1)) $P(ACDH(1),"=",79)="=" W !!!,ACDH(1)
S DA=+ACDVISP,DIK="^ACDPD(" D ^DIK W !,"** INCOMPLETE or INCORRECT ** PREVENTION LINK deleted from prevention file. **",!,ACDH(1)
W !!?4,"Prevention Deletion Complete...."
Q
;
EN3 ;EP Delete a prevention entry - interactive
;//[ACDDIK1]
W @IOF,"Signon Program is : ",$P(^DIC(4,DUZ(2),0),U)
W !,"Prevention records to Delete are: THOSE NOT EXTRACTED."
W !," THOSE WITHIN YOUR SIGNIN PROGRAM.",!
W !,"DELETING CDMIS PREVENTION RECORDS...",!!
S DIC("S")="I $P(^(0),U,4)=DUZ(2),'$P(^(0),U,25)"
S:'$D(ACDH(1)) $P(ACDH(1),"=",79)="=" S DIC(0)="AEQ",DIC="^ACDPD(" D ^DIC G:Y<0 K S ACDVISP=+Y
S:'$D(ACD80) $P(ACD80,"=",79)="=" W !,ACD80
F S %=2 W !,"Are You Sure You wish to DELETE this ENTRY" D YN^DICN W:%=0 " Answer Yes or No" Q:%=2!(%=-1) I %=1 D DEL G K
W " No action taken...."
K ;
K DIC,DIK,DIE,DR,DA,ACDLP,ACDH,ACDM,ACDAY,ACD80
Q
ACDPDA ;IHS/ADC/EDE/KML - DATA ENTRY/EDIT/DELETE FOR PREVENTION;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
EN ;Add prevention days
+1 ;//[ACD 1PSADD]
+2 WRITE @IOF,"Signon Program is : ",$PIECE(^DIC(4,DUZ(2),0),U)
+3 WRITE !,"Records that may be added are: THOSE WITHIN YOUR SIGNIN PROGRAM.",!
+4 WRITE !,"ADDING CDMIS PREVENTION RECORDS...",!!
+5 KILL ACDVISP
SET DIC("DR")=""
+6 SET DIE="^ACDF5PI("
+7 KILL DTOUT
SET DR="[ACD PREVENTION DAY]"
SET DIE("NO^")="BACK"
SET DA=DUZ(2)
DO ^DIE
KILL DIE,DIC,DR,DA
IF $DATA(DTOUT)!('$DATA(ACDVISP))
DO CHK
GOTO K
+8 ; Above input template shifts to the CDMIS PREVENTION file and does
+9 ; a forced add. No lock required.
+10 ;
EN1 ;ASK DAYS OVER AND OVER
+1 KILL ACDM,X
+2 KILL DIR,X,Y
SET DIR(0)="9002170.75,.01"
DO ^DIR
IF X["^"!($DATA(DTOUT))!(X="")
GOTO CHK
SET ACDM(1)=Y
+3 KILL DIR,X,Y
SET DIR(0)="P^9002170.9:AEQM"
DO ^DIR
IF X["^"!($DATA(DTOUT))
GOTO CHK
SET ACDM(2)=+Y
+4 KILL DIR,X,Y
SET DIR(0)="P^9002170.8:AEQM"
DO ^DIR
IF X["^"!($DATA(DTOUT))
GOTO CHK
SET ACDM(3)=+Y
+5 KILL DIR,X,Y
SET DIR(0)="9002170.75,3"
DO ^DIR
IF X["^"!($DATA(DTOUT))
GOTO CHK
SET ACDM(4)=Y
+6 KILL DIR,X,Y
SET DIR(0)="9002170.75,4"
DO ^DIR
IF X["^"!($DATA(DTOUT))
GOTO CHK
SET ACDM(5)=Y
+7 KILL DIR,X,Y
SET DIR(0)="9002170.75,5"
DO ^DIR
IF X["^"!($DATA(DTOUT))
GOTO CHK
SET ACDM(6)=Y
+8 KILL DIR,X,Y
SET DIR(0)="9002170.75,8"
DO ^DIR
IF X["^"!($DATA(DTOUT))
GOTO CHK
SET ACDM(7)=Y
+9 FOR ACDLP=1:1:7
IF '$DATA(ACDM(ACDLP))
DO CHK
GOTO K
+10 ;
+11 SET DA(1)=ACDVISP
+12 SET DIC="^ACDPD("_DA(1)_",1,"
SET DIE=DIC
+13 IF '$DATA(@(DIC_"0)"))
SET @(DIC_"0)")="^9002170.75AI"
+14 SET X=ACDM(1)
+15 SET DIC("DR")="1////"_ACDM(2)_";2////"_ACDM(3)_";3////"_ACDM(4)_";4////"_ACDM(5)_";5////"_ACDM(6)_";8////"_ACDM(7)
+16 SET DIC(0)="L"
+17 DO FILE^ACDFMC
+18 ;
PV ;
+1 ;Ask user for secondary providers
+2 SET DA(1)=ACDVISP
+3 SET DIE="^ACDPD("_DA(1)_",1,"
+4 SET DA=+Y
SET DR=6
SET DIE("NO^")="BACK"
DO DIE^ACDFMC
+5 ;
+6 WRITE !,"Day entry filed......"
DO K
+7 WRITE !!
GOTO EN1
+8 ;
EN2 ;EP Edit Prevention days
+1 ;//[ACD 1PSEDIT]
+2 WRITE @IOF,"Signon Program is : ",$PIECE(^DIC(4,DUZ(2),0),U)
+3 WRITE !,"Editable Records are: THOSE NOT EXTRACTED."
+4 WRITE !," THOSE WITHIN YOUR SIGNIN PROGRAM.",!
+5 WRITE !,"EDITING CDMIS PREVENTION RECORDS...",!!
+6 SET DIE="^ACDF5PI("
SET DA=DUZ(2)
SET DR="[ACD PREVENTION EDIT]"
DO ^DIE
+7 LOCK
+8 GOTO CHK
+9 ;
CHK ;Check for valid entry
+1 IF '$DATA(ACDVISP)
QUIT
+2 IF $DATA(^ACDPD(+ACDVISP,0))
IF '$ORDER(^ACDPD(+ACDVISP,1,0))
DO DEL
+3 IF $DATA(ACDVISP)
IF $DATA(^ACDPD(+ACDVISP,0))
FOR
DO CHK2
IF ACDQ
QUIT
+4 SET ACDQ=0
+5 IF $DATA(ACDM)
GOTO K
+6 QUIT
+7 ;
CHK2 ;Allow display/edit
+1 SET ACDQ=1
+2 WRITE !!,"You may now display or edit the CDMIS PREVENTION record just created or edited."
+3 SET DIR(0)="S^0:Continue;1:Display record;2:Edit record"
SET DIR("B")="0"
KILL DA
DO ^DIR
KILL DIR
+4 SET ACDY=Y
+5 IF 'ACDY
QUIT
+6 WRITE !
+7 IF ACDY=1
SET DIC="^ACDPD("
SET DA=+ACDVISP
SET ACDQ=0
KILL DR
DO DIQ^ACDFMC
DO PAUSE^ACDDEU
QUIT
+8 ; must be 2 edit
+9 SET DIE="^ACDPD("
SET DA=+ACDVISP
SET DR="[ACD PREVENTION EDIT]"
+10 DO DIE^ACDFMC
+11 SET ACDQ=0
+12 QUIT
+13 ;
DEL ;Delete incomplete/incorrect entries
+1 IF '$DATA(ACDVISP)
QUIT
+2 IF '$DATA(ACDH(1))
SET $PIECE(ACDH(1),"=",79)="="
WRITE !!!,ACDH(1)
+3 SET DA=+ACDVISP
SET DIK="^ACDPD("
DO ^DIK
WRITE !,"** INCOMPLETE or INCORRECT ** PREVENTION LINK deleted from prevention file. **",!,ACDH(1)
+4 WRITE !!?4,"Prevention Deletion Complete...."
+5 QUIT
+6 ;
EN3 ;EP Delete a prevention entry - interactive
+1 ;//[ACDDIK1]
+2 WRITE @IOF,"Signon Program is : ",$PIECE(^DIC(4,DUZ(2),0),U)
+3 WRITE !,"Prevention records to Delete are: THOSE NOT EXTRACTED."
+4 WRITE !," THOSE WITHIN YOUR SIGNIN PROGRAM.",!
+5 WRITE !,"DELETING CDMIS PREVENTION RECORDS...",!!
+6 SET DIC("S")="I $P(^(0),U,4)=DUZ(2),'$P(^(0),U,25)"
+7 IF '$DATA(ACDH(1))
SET $PIECE(ACDH(1),"=",79)="="
SET DIC(0)="AEQ"
SET DIC="^ACDPD("
DO ^DIC
IF Y<0
GOTO K
SET ACDVISP=+Y
+8 IF '$DATA(ACD80)
SET $PIECE(ACD80,"=",79)="="
WRITE !,ACD80
+9 FOR
SET %=2
WRITE !,"Are You Sure You wish to DELETE this ENTRY"
DO YN^DICN
IF %=0
WRITE " Answer Yes or No"
IF %=2!(%=-1)
QUIT
IF %=1
DO DEL
GOTO K
+10 WRITE " No action taken...."
K ;
+1 KILL DIC,DIK,DIE,DR,DA,ACDLP,ACDH,ACDM,ACDAY,ACD80
+2 QUIT
