ACDCINV2.m

ACDCINV2 ;IHS/ADC/EDE/KML - DATA ADD FOR INTERVENTIONS;

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 ;

START ;

 D MAIN

 D EOJ

 Q

 ;

MAIN ;

 D INIT

 Q:ACDQ

 F  D GETDATA Q:ACDQ  ;      get data until no more

 Q

 ;

INIT ;

 S ACDQ=1

 Q:'$D(IOF)

 Q:'$G(DUZ(2))

 Q:'$D(^ACDF5PI(DUZ(2),0))  ;   should never happen

 S ACDPGM=DUZ(2)

 Q:'$G(IO)

 S Y=$O(^%ZIS(1,"C",IO,0)) I Y S Y=$P($G(^%ZIS(1,Y,"SUBTYPE")),U) I Y S X=$G(^%ZIS(2,Y,5)),ACDRVON=$P(X,U,4),ACDRVOF=$P(X,U,5)

 I $G(ACDRVON)="" S ACDRVON="""""",ACDRVOF=""""""

 S ACDDUZZ=DUZ(2)

 K ^TMP("ACD",$J),^TMP($J)

 S ACDQ=0

 Q

 ;

GETDATA ; GET INTERVENTION DATA/GENERATE RECORDS

 D GETVDATE ;              get visit date

 Q:ACDQ

 F  D GETPATS Q:ACDQ  ;    get patients until no more

 W !

 S ACDQ=0

 Q

 ;

GETVDATE ; GET VISIT DATE

 S ACDQ=1

 S DIR(0)="9002173.5,.01",DIR("A")="VISIT DATE" K DA D ^DIR K DIR

 Q:$D(DIRUT)

 S (ACDDOV,ACDVDTI)=Y,ACDVDTE=Y(0)

 S ACDQ=0

 Q

 ;

GETPATS ; GET PATIENTS

 D GETPAT

 Q:ACDQ

 S DIC="^ACDINTV(",DIC(0)="L",DLAYGO=9002173.5,X=ACDVDTI

 S DIC("DR")="1////"_ACDDFN_";2////"_ACDTRBCD_";3////"_ACDSEX_";4////"_ACDAGE_";19////"_ACDPGM_";22////"_ACDSTACD_";23////"_ACDSTA_";24////"_ACDTRB_";25////"_ACDVET

 D FILE^ACDFMC

 I +Y<0 W !,"Creation of INTERVENTION entry failed.  Notify programmer.",!! S ACDQ=1 S:$D(^%ZOSF("$ZE")) X="CDMIS INTERVENTION",@^("$ZE") D @^%ZOSF("ERRTN") Q

 W !!,"---------- INTERVENTION INFO SECTION ----------"

 S ACDIVIEN=+Y

 S DIE="^ACDINTV(",DIE("NO^")="BACK",DA=ACDIVIEN,DR="[ACD INTERVENTIONS ADD]"

 D DIE^ACDFMC

 I $D(DTOUT)!($D(Y)) S DIK="^ACDINTV(",DA=ACDIVIEN D ^DIK W !,"** INCOMPLETE OR INCORRECT INTERVENTION ENTRY DELETED **"

 Q

 ;

GETPAT ; GET PATIENT DATA

 W !!

 D GETNAME

 Q:ACDQ

 W !!,"---------- PATIENT DEMOGRAPHIC SECTION ----------"

 D GETSEX

 Q:ACDQ

 D GETAGE

 Q:ACDQ

 D GETSTATE

 Q:ACDQ

 D GETTRIBE

 Q:ACDQ

 D GETVET

 Q:ACDQ

 Q

 ;

GETNAME ; GET PATIENT NAME

 S ACDQ=1

 S DIR(0)="FO^3:30",DIR("A")="Enter patient's name" K DA D ^DIR K DIR

 Q:$D(DIRUT)

 Q:Y=""

 S ACDDFN=Y

 S ACDQ=0

 Q

 ;

GETSEX ; GET PATIENT SEX

 S ACDQ=1

 S DIR(0)="SO^M:MALE;F:FEMALE",DIR("A")="Enter patient's sex" K DA D ^DIR K DIR

 Q:$D(DIRUT)

 Q:Y=""

 S ACDSEX=Y

 S ACDQ=0

 Q

 ;

GETAGE ; GET PATIENT AGE

 S ACDQ=1

 S DIR(0)="NO^1:120:0",DIR("A")="Enter patient's age" K DA D ^DIR K DIR

 Q:$D(DIRUT)

 Q:Y=""

 S ACDAGE=Y

 S ACDQ=0

 Q

 ;

GETSTATE ; GET PATIENT STATE OF RESIDENCE

 S ACDQ=1

 S DIR(0)="9002173.5,23",DIR("A")="Enter patient's state of residence" K DA D ^DIR K DIR

 Q:$D(DIRUT)

 Q:Y=""

 S ACDSTA=+Y

 S ACDSTACD=$$VALI^XBDIQ1(5,ACDSTA,2)

 S ACDQ=0

 Q

 ;

GETTRIBE ; GET PATIENT TRIBE OF MEMBERSHIP

 S ACDQ=1

 S DIR(0)="9002173.5,24",DIR("A")="Enter patient's tribe" K DA D ^DIR K DIR

 Q:$D(DIRUT)

 Q:Y=""

 S ACDTRB=+Y

 S ACDTRBCD=$$VALI^XBDIQ1(9999999.03,ACDTRB,.02)

 S ACDQ=0

 Q

 ;

GETVET ; GET PATIENT VETERAN STATUS

 S ACDQ=1

 S DIR(0)="9002173.5,25",DIR("A")="Is patient a veteran",DIR("B")="N" K DA D ^DIR K DIR

 Q:$D(DIRUT)

 Q:Y=""

 S ACDVET=Y

 S ACDQ=0

 Q

 ;

EOJ ;

 D ^ACDKILL

 Q

ACDCINV2  ;IHS/ADC/EDE/KML - DATA ADD FOR INTERVENTIONS;

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;

START     ;

 +1        DO MAIN

 +2        DO EOJ

 +3        QUIT 

 +4       ;

MAIN      ;

 +1        DO INIT

 +2        IF ACDQ

               QUIT 

 +3       ;      get data until no more

           FOR 

               DO GETDATA

               IF ACDQ

                   QUIT 

 +4        QUIT 

 +5       ;

INIT      ;

 +1        SET ACDQ=1

 +2        IF '$DATA(IOF)

               QUIT 

 +3        IF '$GET(DUZ(2))

               QUIT 

 +4       ;   should never happen

           IF '$DATA(^ACDF5PI(DUZ(2),0))

               QUIT 

 +5        SET ACDPGM=DUZ(2)

 +6        IF '$GET(IO)

               QUIT 

 +7        SET Y=$ORDER(^%ZIS(1,"C",IO,0))

           IF Y

               SET Y=$PIECE($GET(^%ZIS(1,Y,"SUBTYPE")),U)

               IF Y

                   SET X=$GET(^%ZIS(2,Y,5))

                   SET ACDRVON=$PIECE(X,U,4)

                   SET ACDRVOF=$PIECE(X,U,5)

 +8        IF $GET(ACDRVON)=""

               SET ACDRVON=""""""

               SET ACDRVOF=""""""

 +9        SET ACDDUZZ=DUZ(2)

 +10       KILL ^TMP("ACD",$JOB),^TMP($JOB)

 +11       SET ACDQ=0

 +12       QUIT 

 +13      ;

GETDATA   ; GET INTERVENTION DATA/GENERATE RECORDS

 +1       ;              get visit date

           DO GETVDATE

 +2        IF ACDQ

               QUIT 

 +3       ;    get patients until no more

           FOR 

               DO GETPATS

               IF ACDQ

                   QUIT 

 +4        WRITE !

 +5        SET ACDQ=0

 +6        QUIT 

 +7       ;

GETVDATE  ; GET VISIT DATE

 +1        SET ACDQ=1

 +2        SET DIR(0)="9002173.5,.01"

           SET DIR("A")="VISIT DATE"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        SET (ACDDOV,ACDVDTI)=Y

           SET ACDVDTE=Y(0)

 +5        SET ACDQ=0

 +6        QUIT 

 +7       ;

GETPATS   ; GET PATIENTS

 +1        DO GETPAT

 +2        IF ACDQ

               QUIT 

 +3        SET DIC="^ACDINTV("

           SET DIC(0)="L"

           SET DLAYGO=9002173.5

           SET X=ACDVDTI

 +4        SET DIC("DR")="1////"_ACDDFN_";2////"_ACDTRBCD_";3////"_ACDSEX_";4////"_ACDAGE_";19////"_ACDPGM_";22////"_ACDSTACD_";23////"_ACDSTA_";24////"_ACDTRB_";25////"_ACDVET

 +5        DO FILE^ACDFMC

 +6        IF +Y<0

               WRITE !,"Creation of INTERVENTION entry failed.  Notify programmer.",!!

               SET ACDQ=1

               IF $DATA(^%ZOSF("$ZE"))

                   SET X="CDMIS INTERVENTION"

                   SET @^("$ZE")

               DO @^%ZOSF("ERRTN")

               QUIT 

 +7        WRITE !!,"---------- INTERVENTION INFO SECTION ----------"

 +8        SET ACDIVIEN=+Y

 +9        SET DIE="^ACDINTV("

           SET DIE("NO^")="BACK"

           SET DA=ACDIVIEN

           SET DR="[ACD INTERVENTIONS ADD]"

 +10       DO DIE^ACDFMC

 +11       IF $DATA(DTOUT)!($DATA(Y))

               SET DIK="^ACDINTV("

               SET DA=ACDIVIEN

               DO ^DIK

               WRITE !,"** INCOMPLETE OR INCORRECT INTERVENTION ENTRY DELETED **"

 +12       QUIT 

 +13      ;

GETPAT    ; GET PATIENT DATA

 +1        WRITE !!

 +2        DO GETNAME

 +3        IF ACDQ

               QUIT 

 +4        WRITE !!,"---------- PATIENT DEMOGRAPHIC SECTION ----------"

 +5        DO GETSEX

 +6        IF ACDQ

               QUIT 

 +7        DO GETAGE

 +8        IF ACDQ

               QUIT 

 +9        DO GETSTATE

 +10       IF ACDQ

               QUIT 

 +11       DO GETTRIBE

 +12       IF ACDQ

               QUIT 

 +13       DO GETVET

 +14       IF ACDQ

               QUIT 

 +15       QUIT 

 +16      ;

GETNAME   ; GET PATIENT NAME

 +1        SET ACDQ=1

 +2        SET DIR(0)="FO^3:30"

           SET DIR("A")="Enter patient's name"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        IF Y=""

               QUIT 

 +5        SET ACDDFN=Y

 +6        SET ACDQ=0

 +7        QUIT 

 +8       ;

GETSEX    ; GET PATIENT SEX

 +1        SET ACDQ=1

 +2        SET DIR(0)="SO^M:MALE;F:FEMALE"

           SET DIR("A")="Enter patient's sex"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        IF Y=""

               QUIT 

 +5        SET ACDSEX=Y

 +6        SET ACDQ=0

 +7        QUIT 

 +8       ;

GETAGE    ; GET PATIENT AGE

 +1        SET ACDQ=1

 +2        SET DIR(0)="NO^1:120:0"

           SET DIR("A")="Enter patient's age"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        IF Y=""

               QUIT 

 +5        SET ACDAGE=Y

 +6        SET ACDQ=0

 +7        QUIT 

 +8       ;

GETSTATE  ; GET PATIENT STATE OF RESIDENCE

 +1        SET ACDQ=1

 +2        SET DIR(0)="9002173.5,23"

           SET DIR("A")="Enter patient's state of residence"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        IF Y=""

               QUIT 

 +5        SET ACDSTA=+Y

 +6        SET ACDSTACD=$$VALI^XBDIQ1(5,ACDSTA,2)

 +7        SET ACDQ=0

 +8        QUIT 

 +9       ;

GETTRIBE  ; GET PATIENT TRIBE OF MEMBERSHIP

 +1        SET ACDQ=1

 +2        SET DIR(0)="9002173.5,24"

           SET DIR("A")="Enter patient's tribe"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        IF Y=""

               QUIT 

 +5        SET ACDTRB=+Y

 +6        SET ACDTRBCD=$$VALI^XBDIQ1(9999999.03,ACDTRB,.02)

 +7        SET ACDQ=0

 +8        QUIT 

 +9       ;

GETVET    ; GET PATIENT VETERAN STATUS

 +1        SET ACDQ=1

 +2        SET DIR(0)="9002173.5,25"

           SET DIR("A")="Is patient a veteran"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               QUIT 

 +4        IF Y=""

               QUIT 

 +5        SET ACDVET=Y

 +6        SET ACDQ=0

 +7        QUIT 

 +8       ;

EOJ       ;

 +1        DO ^ACDKILL

 +2        QUIT