ACDDE3B.m

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