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
