ACDDE3B ;IHS/ADC/EDE/KML - GENERATE SUBORDINATE FILE ENTRIES;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
GENIIF ; EP - GENERATE NEW CDMIS INIT/INFO/FU
D GENIIF2
I (ACDFHCP+ACDFPCC),$G(ACDDFNP) S Y=$O(^ACDIIF("C",ACDVIEN,0)) I Y S ACDPCCL(ACDDFNP,ACDVIEN,"IIF",Y)=""
Q
;
GENIIF2 ;
S ACDQ=1
S DIE="^ACDVIS(",DA=ACDVIEN,DR="[ACD INIT/INFO/FU ADD]",DIE("NO^")="BACK"
D DIE^ACDFMC
Q:$D(DTOUT)!($D(DUOUT))
I $D(Y) W !,IORVON,"Creation of CDMIS INIT/INFO/FU record failed. Notify programmer.",IORVOFF,!! S:$D(^%ZOSF("$ZE")) X="CDMIS INIT/INFO/FU",@^("$ZE") D @^%ZOSF("ERRTN") D PAUSE^ACDDEU Q
I '$G(ACDIIEN) S ACDQ=0 Q ; must have hit return to .01 field
S ACDCEFLE="INIT/INFO/FU",ACDCEGBL="^ACDIIF(",ACDCEIEN=ACDIIEN
F D CHKEDIT Q:ACDQ
K ACDCEFLE,ACDCEGBL,ACDCEIEN
S ACDQ=0
Q
;
GENTDC ; EP - GENERATE NEW CDMIS TRANS/DISC/CLOSE
D GENTDC2
I (ACDFHCP+ACDFPCC) S Y=$O(^ACDTDC("C",ACDVIEN,0)) I Y S ACDPCCL(ACDDFNP,ACDVIEN,"TDC",Y)=""
Q
;
GENTDC2 ;
S ACDQ=1
S DIE="^ACDVIS(",DA=ACDVIEN,DR="[ACD TRANS/DISC/CLOSE ADD]",DIE("NO^")="BACK"
D DIE^ACDFMC
Q:$D(DTOUT)!($D(DUOUT))
I $D(Y)!('$G(ACDTDC)) W !,IORVON,"Creation of CDMIS TRANS/DISC/CLOSE record failed. Notify programmer.",IORVOFF,!! S ACDQ=1 S:$D(^%ZOSF("$ZE")) X="CDMIS TRANS/DISC/CLOSE",@^("$ZE") D @^%ZOSF("ERRTN") D PAUSE^ACDDEU Q
S ACDCEFLE="TRANS/DISC/CLOSE",ACDCEGBL="^ACDTDC(",ACDCEIEN=ACDTDC
F D CHKEDIT Q:ACDQ
K ACDCEFLE,ACDCEGBL,ACDCEIEN
S ACDQ=0
Q
;
GENCS ; EP - GENERATE NEW CDMIS CLIENT SVCS
K ACDCS ; kill client svcs array set by input template
F D GENCS2 Q:ACDQ
S ACDQ=0
I (ACDFHCP+ACDFPCC) S Y=0 F S Y=$O(ACDCS(Y)) Q:'Y S ACDPCCL(ACDDFNP,ACDVIEN,"CS",Y)=""
Q
;
GENCS2 ; ALLOW COPY SETS/CLIENT SVCS UNTIL ALL DONE
S ACDQ=1
S DIR(0)="SO^"_$S($D(ACDCS):"0:Exit;",1:"")_"1:Individual Client Services;2:Group Client Services",DIR("A")="Do you want to "_$S($D(ACDCS):"exit or ",1:"")_"enter individual client services or perform group client services"
S DIR("B")=$S($D(ACDCS):"0",1:"1") K DA D ^DIR K DIR
Q:$D(DIRUT)
Q:Y=0
I Y=1 D GENCSI I 1 ; generate individual client services
E D GENCSM^ACDDE3C ; generate a copy set of client services (group client services)
Q:ACDQ
S ACDCEFLE="CLIENT SVCS",ACDCEGBL="^ACDCS(",ACDCEIEN=0
F D CHKEDIT Q:ACDQ
K ACDCEFLE,ACDCEGBL,ACDCEIEN
S ACDQ=0
Q
;
GENCSI ; GENERATE INDIVIDUAL CLIENT SVCS
S DIE="^ACDVIS(",DA=ACDVIEN,DR="[ACD CLIENT SVCS ADD]",DIE("NO^")="BACK"
D DIE^ACDFMC
Q:$D(DTOUT)
I $D(Y) W !,IORVON,"Creation of CDMIS CLIENT SVCS record failed. Notify programmer.",IORVOFF,!! S ACDQ=1 S:$D(^%ZOSF("$ZE")) X="CDMIS CLIENT SVCS",@^("$ZE") D @^%ZOSF("ERRTN") D PAUSE^ACDDEU Q
Q:'$D(ACDCS) ; no CS records created
S ACDQ=0
Q
;
CHKEDIT ; ALLOW EDIT OF RECORD(S) JUST GENERATED
S ACDQ=1
W !!,"You may now display or edit the CDMIS ",ACDCEFLE," record(s) just created."
S DIR(0)="S^0:Continue;1:Display record;2:Edit record" S:ACDCONT="CS" DIR(0)=DIR(0)_";3:Delete record" S DIR("B")="0" K DA D ^DIR K DIR
S ACDY=Y
Q:'ACDY
I ACDCONT="CS" D CHKEDIT2 Q:'ACDCEIEN ; select one CS entry
W !
I ACDY=1 S DIC=ACDCEGBL,DA=ACDCEIEN,ACDQ=0 D DIQ^ACDFMC,PAUSE^ACDDEU Q
I ACDY=3 D Q ; make sure they really want to delete then do it
. S ACDQ=0
. S DIR(0)="YO",DIR("A")="Are you sure you want to delete this entry",DIR("B")="N" K DA D ^DIR K DIR
. Q:'Y ; guess they changed their mind
. K ACDCS(ACDCEIEN) S DIK="^ACDCS(",DA=ACDCEIEN D DIK^ACDFMC
. Q
; must be 2 edit
S DIE=ACDCEGBL,DA=ACDCEIEN,DR="[ACD "_ACDCEFLE_" EDIT]"
D DIE^ACDFMC
S ACDQ=0
Q
;
CHKEDIT2 ; SELECT ONE CS ENTRY
N ACDY
S ACDCEIEN=0
K ACDX
W !,?5,"Select one of the following:",!!
S (ACDLC,ACDY)=0
F S ACDY=$O(ACDCS(ACDY)) Q:'ACDY D
. S ACDLC=ACDLC+1
. S ACDX(ACDLC)=ACDY
. S X=^ACDCS(ACDY,0),Z=$P(X,U,2),X=+X
. D PFTV^XBPFTV(9002170.6,Z,.Z)
. W ?10,ACDLC,?20,X,?25,Z,!
. I '(ACDLC#20) D PAUSE^ACDDEU W !
. Q
S DIR(0)="NO^1:"_ACDLC_":0",DIR("A")="Select one Client Service entry." K DA D ^DIR K DIR
K ACDLC
Q:$D(DIRUT)
S ACDCEIEN=ACDX(Y)
Q
ACDDE3B ;IHS/ADC/EDE/KML - GENERATE SUBORDINATE FILE ENTRIES;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
GENIIF ; EP - GENERATE NEW CDMIS INIT/INFO/FU
+1 DO GENIIF2
+2 IF (ACDFHCP+ACDFPCC)
IF $GET(ACDDFNP)
SET Y=$ORDER(^ACDIIF("C",ACDVIEN,0))
IF Y
SET ACDPCCL(ACDDFNP,ACDVIEN,"IIF",Y)=""
+3 QUIT
+4 ;
GENIIF2 ;
+1 SET ACDQ=1
+2 SET DIE="^ACDVIS("
SET DA=ACDVIEN
SET DR="[ACD INIT/INFO/FU ADD]"
SET DIE("NO^")="BACK"
+3 DO DIE^ACDFMC
+4 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+5 IF $DATA(Y)
WRITE !,IORVON,"Creation of CDMIS INIT/INFO/FU record failed. Notify programmer.",IORVOFF,!!
IF $DATA(^%ZOSF("$ZE"))
SET X="CDMIS INIT/INFO/FU"
SET @^("$ZE")
DO @^%ZOSF("ERRTN")
DO PAUSE^ACDDEU
QUIT
+6 ; must have hit return to .01 field
IF '$GET(ACDIIEN)
SET ACDQ=0
QUIT
+7 SET ACDCEFLE="INIT/INFO/FU"
SET ACDCEGBL="^ACDIIF("
SET ACDCEIEN=ACDIIEN
+8 FOR
DO CHKEDIT
IF ACDQ
QUIT
+9 KILL ACDCEFLE,ACDCEGBL,ACDCEIEN
+10 SET ACDQ=0
+11 QUIT
+12 ;
GENTDC ; EP - GENERATE NEW CDMIS TRANS/DISC/CLOSE
+1 DO GENTDC2
+2 IF (ACDFHCP+ACDFPCC)
SET Y=$ORDER(^ACDTDC("C",ACDVIEN,0))
IF Y
SET ACDPCCL(ACDDFNP,ACDVIEN,"TDC",Y)=""
+3 QUIT
+4 ;
GENTDC2 ;
+1 SET ACDQ=1
+2 SET DIE="^ACDVIS("
SET DA=ACDVIEN
SET DR="[ACD TRANS/DISC/CLOSE ADD]"
SET DIE("NO^")="BACK"
+3 DO DIE^ACDFMC
+4 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+5 IF $DATA(Y)!('$GET(ACDTDC))
WRITE !,IORVON,"Creation of CDMIS TRANS/DISC/CLOSE record failed. Notify programmer.",IORVOFF,!!
SET ACDQ=1
IF $DATA(^%ZOSF("$ZE"))
SET X="CDMIS TRANS/DISC/CLOSE"
SET @^("$ZE")
DO @^%ZOSF("ERRTN")
DO PAUSE^ACDDEU
QUIT
+6 SET ACDCEFLE="TRANS/DISC/CLOSE"
SET ACDCEGBL="^ACDTDC("
SET ACDCEIEN=ACDTDC
+7 FOR
DO CHKEDIT
IF ACDQ
QUIT
+8 KILL ACDCEFLE,ACDCEGBL,ACDCEIEN
+9 SET ACDQ=0
+10 QUIT
+11 ;
GENCS ; EP - GENERATE NEW CDMIS CLIENT SVCS
+1 ; kill client svcs array set by input template
KILL ACDCS
+2 FOR
DO GENCS2
IF ACDQ
QUIT
+3 SET ACDQ=0
+4 IF (ACDFHCP+ACDFPCC)
SET Y=0
FOR
SET Y=$ORDER(ACDCS(Y))
IF 'Y
QUIT
SET ACDPCCL(ACDDFNP,ACDVIEN,"CS",Y)=""
+5 QUIT
+6 ;
GENCS2 ; ALLOW COPY SETS/CLIENT SVCS UNTIL ALL DONE
+1 SET ACDQ=1
+2 SET DIR(0)="SO^"_$SELECT($DATA(ACDCS):"0:Exit;",1:"")_"1:Individual Client Services;2:Group Client Services"
SET DIR("A")="Do you want to "_$SELECT($DATA(ACDCS):"exit or ",1:"")_"enter individual client services or perform group client services"
+3 SET DIR("B")=$SELECT($DATA(ACDCS):"0",1:"1")
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
QUIT
+5 IF Y=0
QUIT
+6 ; generate individual client services
IF Y=1
DO GENCSI
IF 1
+7 ; generate a copy set of client services (group client services)
IF '$TEST
DO GENCSM^ACDDE3C
+8 IF ACDQ
QUIT
+9 SET ACDCEFLE="CLIENT SVCS"
SET ACDCEGBL="^ACDCS("
SET ACDCEIEN=0
+10 FOR
DO CHKEDIT
IF ACDQ
QUIT
+11 KILL ACDCEFLE,ACDCEGBL,ACDCEIEN
+12 SET ACDQ=0
+13 QUIT
+14 ;
GENCSI ; GENERATE INDIVIDUAL CLIENT SVCS
+1 SET DIE="^ACDVIS("
SET DA=ACDVIEN
SET DR="[ACD CLIENT SVCS ADD]"
SET DIE("NO^")="BACK"
+2 DO DIE^ACDFMC
+3 IF $DATA(DTOUT)
QUIT
+4 IF $DATA(Y)
WRITE !,IORVON,"Creation of CDMIS CLIENT SVCS record failed. Notify programmer.",IORVOFF,!!
SET ACDQ=1
IF $DATA(^%ZOSF("$ZE"))
SET X="CDMIS CLIENT SVCS"
SET @^("$ZE")
DO @^%ZOSF("ERRTN")
DO PAUSE^ACDDEU
QUIT
+5 ; no CS records created
IF '$DATA(ACDCS)
QUIT
+6 SET ACDQ=0
+7 QUIT
+8 ;
CHKEDIT ; ALLOW EDIT OF RECORD(S) JUST GENERATED
+1 SET ACDQ=1
+2 WRITE !!,"You may now display or edit the CDMIS ",ACDCEFLE," record(s) just created."
+3 SET DIR(0)="S^0:Continue;1:Display record;2:Edit record"
IF ACDCONT="CS"
SET DIR(0)=DIR(0)_";3:Delete record"
SET DIR("B")="0"
KILL DA
DO ^DIR
KILL DIR
+4 SET ACDY=Y
+5 IF 'ACDY
QUIT
+6 ; select one CS entry
IF ACDCONT="CS"
DO CHKEDIT2
IF 'ACDCEIEN
QUIT
+7 WRITE !
+8 IF ACDY=1
SET DIC=ACDCEGBL
SET DA=ACDCEIEN
SET ACDQ=0
DO DIQ^ACDFMC
DO PAUSE^ACDDEU
QUIT
+9 ; make sure they really want to delete then do it
IF ACDY=3
Begin DoDot:1
+10 SET ACDQ=0
+11 SET DIR(0)="YO"
SET DIR("A")="Are you sure you want to delete this entry"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+12 ; guess they changed their mind
IF 'Y
QUIT
+13 KILL ACDCS(ACDCEIEN)
SET DIK="^ACDCS("
SET DA=ACDCEIEN
DO DIK^ACDFMC
+14 QUIT
End DoDot:1
QUIT
+15 ; must be 2 edit
+16 SET DIE=ACDCEGBL
SET DA=ACDCEIEN
SET DR="[ACD "_ACDCEFLE_" EDIT]"
+17 DO DIE^ACDFMC
+18 SET ACDQ=0
+19 QUIT
+20 ;
CHKEDIT2 ; SELECT ONE CS ENTRY
+1 NEW ACDY
+2 SET ACDCEIEN=0
+3 KILL ACDX
+4 WRITE !,?5,"Select one of the following:",!!
+5 SET (ACDLC,ACDY)=0
+6 FOR
SET ACDY=$ORDER(ACDCS(ACDY))
IF 'ACDY
QUIT
Begin DoDot:1
+7 SET ACDLC=ACDLC+1
+8 SET ACDX(ACDLC)=ACDY
+9 SET X=^ACDCS(ACDY,0)
SET Z=$PIECE(X,U,2)
SET X=+X
+10 DO PFTV^XBPFTV(9002170.6,Z,.Z)
+11 WRITE ?10,ACDLC,?20,X,?25,Z,!
+12 IF '(ACDLC#20)
DO PAUSE^ACDDEU
WRITE !
+13 QUIT
End DoDot:1
+14 SET DIR(0)="NO^1:"_ACDLC_":0"
SET DIR("A")="Select one Client Service entry."
KILL DA
DO ^DIR
KILL DIR
+15 KILL ACDLC
+16 IF $DATA(DIRUT)
QUIT
+17 SET ACDCEIEN=ACDX(Y)
+18 QUIT
