ACDDEM ;IHS/ADC/EDE/KML - DATA ENTRY EDIT MODE;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
;This is the data entry edit driver routine for CDMIS. This
;routine will ask for COMPONENT CODE/TYPE, then loop within
;that component asking for TYPE CONTACT, and then if patient
;related it will ask for patient and then date. If not patient
;related it will ask for date. Once a visit is selected the
;user will be able to optionally edit the visit and then the
;subordinate file entries attached to the visit.
;
EDIT ; EP - EDIT CDMIS FORMS
S ACDMODE="E"
D MAIN
Q
;
MAIN ; MAINLINE LOGIC
D INIT^ACDDE2
I ACDQ D EOJ Q
F D LOOP Q:ACDQ ; loop within component code/type
D EOJ
Q
;
LOOP ; LOOP WITHIN COMPONENT CODE/TYPE
S ACDLPTYP=1
S (ACDPROV,ACDPROVN)=""
S (ACDCONT,ACDCONTL)=""
S (ACDVDTI,ACDVDTE)=""
S (ACDDFN,ACDDFNP)=""
D HDR^ACDDEU
S ACDNODEF=1
D GETTC^ACDDE2 ; get type contact
Q:ACDQ
I ACDCONT'="IR",ACDCONT'="OT" D GETPAT
Q:ACDQ
D VISIT
S ACDQ=0
Q
;
GETPAT ; GET PATIENT
S ACDQ=1
S AUPNLK("ALL")=1
S DIC="^AUPNPAT(",DIC(0)="AEMQ",DIC("S")="I $D(^ACDVIS(""D"",+Y))" D DIC^ACDFMC
K AUPNLK("ALL")
Q:Y<0
S ACDDFNP=+Y,ACDDFN=$P(^DPT(ACDDFNP,0),U)
S ACDQ=0
Q
;
VISIT ; EDIT VISIT AND SUBORDINATE FILE ENTRIES
S DIC="^ACDVIS(",DIC(0)="AMQ",DIC("S")="I $P(^ACDVIS(+Y,0),U,2)=ACDCOMC,$P(^(0),U,7)=ACDCOMT,$P(^(0),U,4)=ACDCONT,'$P(^(0),U,25),$P(^(""BWP""),U)=ACDPGM" S:ACDDFNP DIC("S")=DIC("S")_",$D(^ACDVIS(""D"",ACDDFNP,+Y))"
D DIC^ACDFMC
Q:Y<0
S ACDVIEN=+Y
I (ACDFHCP+ACDFPCC),$G(ACDDFNP),ACDVIEN S ACDPCCL(ACDDFNP,ACDVIEN)=""
W !
D DSPVSIT^ACDDEU(ACDVIEN)
S DIR(0)="Y",DIR("A")="Do you want to edit the visit record",DIR("B")="NO" K DA D ^DIR K DIR
D:Y EDVISIT ; go edit the visit record itself
D EDTTC ; go edit files based on type contact
I ACDFHCP,$G(ACDDFNP),$D(ACDPCCL(ACDDFNP)) D SAVBILL^ACDDE
I ACDFPCC,$G(ACDDFNP),$D(ACDPCCL(ACDDFNP)) D ^ACDPCCL
Q
;
EDVISIT ; EDIT CDMIS VISIT RECORD
I (ACDFHCP+ACDFPCC),$G(ACDDFNP),ACDVIEN S ACDPCCL(ACDDFNP,ACDVIEN)=1
S DIE="^ACDVIS(",DR="[ACD VISIT EDIT]",DA=ACDVIEN
D DIE^ACDFMC
Q
;
EDTTC ; EDIT FILES BASED ON TYPE CONTACT
W !
D @("EDT"_ACDCONT)
Q
;
EDTIN ; EDIT INITIAL
D EDTIIF ; edit CDMIS INIT/INFO/FU
Q
;
EDTRE ; EDIT REOPEN
D EDTIIF ; edit CDMIS INIT/INFO/FU
Q
;
EDTFU ; EDIT FOLLOWUP
D EDTIIF ; edit CDMIS INIT/INFO/FU
Q
;
EDTTD ; EDIT TRANS/DISC/CLOSE
D EDTTDC ; edit CDMIS TRANS/DISC/CLOSE
Q
;
EDTCS ; EDIT CLIENT SERVICE
D SLCTCS ; select client service to edit
Q:'ACDCEIEN
S DIR(0)="SO^E:Edit;D:Delete",DIR("B")="Edit" K DA D ^DIR K DIR
Q:$D(DIRUT)
I (ACDFHCP+ACDFPCC),$G(ACDDFNP) S ACDPCCL(ACDDFNP,ACDVIEN,"CS",ACDCEIEN)=$S(Y="D":"D",1:"")
I Y="D" S DIK="^ACDCS(",DA=ACDCEIEN D DIK^ACDFMC Q
S DIE="^ACDCS(",DR="[ACD CLIENT SVCS EDIT]",DA=ACDCEIEN
D DIE^ACDFMC
Q
;
SLCTCS ; SELECT ONE CS ENTRY
S ACDCEIEN=0
K ^TMP("ACD",$J,"CS"),ACDDDAY
S ACDVDATE=$P(^ACDVIS(ACDVIEN,0),U)
S (ACDCSC,Y)=0
F S Y=$O(^ACDCS("C",ACDVIEN,Y)) Q:'Y S X=^ACDCS(Y,0),^TMP("ACD",$J,"CS",$P(X,U),Y)=$P(X,U,2),X=$P(X,U) I '$D(ACDDDAY("DAY",X)) D
. NEW Y
. S ACDCSC=ACDCSC+1,ACDDDAY(ACDCSC)=X,Y=ACDVDATE,Y=Y+X
. D DD^%DT
. S ACDDDAY("DAY",X)=" <"_Y_">"
. Q
S ACDCSCUT=(ACDCSC\2)+(ACDCSC#2)
F I=1:1 Q:I>ACDCSCUT S X=ACDDDAY(I) W !?5,I_") DAY "_$J(X,2)_ACDDDAY("DAY",X) S J=I+ACDCSCUT I $D(ACDDDAY(J)) S X=ACDDDAY(J) W ?40,J_") DAY "_$J(X,2)_ACDDDAY("DAY",X)
W !
S DIR(0)="NO^1:"_ACDCSC_":0",DIR("A")="Select one CS day" D ^DIR K DIR
Q:$D(DIRUT)
S ACDCSDAY=ACDDDAY(Y)
K ACDVDATE,ACDDDAY
K ACDX
S DIR(0)="SO^"
S ACDLC=0,W=ACDCSDAY S Y=0 F S Y=$O(^TMP("ACD",$J,"CS",W,Y)) Q:'Y S ACDLC=ACDLC+1,X=^ACDCS(Y,0),Z=$P(X,U,2),X=+X D PFTV^XBPFTV(9002170.6,Z,.Z) S DIR(0)=DIR(0)_$S($L(DIR(0))=3:"",1:";")_ACDLC_":"_X_" "_Z,ACDX(ACDLC)=Y
K ACDCSDAY,ACDLC,^TMP("ACD",$J,"CS")
S DIR("A")="Select one Client Service Entry"
K DA D ^DIR K DIR
Q:$D(DIRUT)
S ACDCEIEN=ACDX(Y)
Q
;
EDTOT ; EDIT CRISIS/BRIED INT
D EDTIIF ; edit CDMIS INIT/INFO/FU
Q
;
EDTIR ; EDIT INFO/REFERRAL
D EDTIIF ; edit CDMIS INIT/INFO/FU
Q
;
EDTIIF ; EDIT CDMIS INIT/INFO/FU
S DA=$O(^ACDIIF("C",ACDVIEN,0))
I 'DA W !,IORVON,"No CDMIS INIT/INFO/FU entry associated with this visit!",IORVOFF,! Q
I (ACDFHCP+ACDFPCC),$G(ACDDFNP) S ACDPCCL(ACDDFNP,ACDVIEN,"IIF",DA)=""
S DIE="^ACDIIF(",DR="[ACD INIT/INFO/FU EDIT]"
D DIE^ACDFMC
Q
;
EDTTDC ; EDIT CDMIS TRANS/DISC/CLOSE
S DA=$O(^ACDTDC("C",ACDVIEN,0))
I 'DA W !,IORVON,"No CDMIS TRANS/DISC/CLOSE entry associated with this visit!",IORVOFF,! Q
I (ACDFHCP+ACDFPCC),$G(ACDDFNP) S ACDPCCL(ACDDFNP,ACDVIEN,"TDC",DA)=""
S DIE="^ACDTDC(",DR="[ACD TRANS/DISC/CLOSE EDIT]"
D DIE^ACDFMC
Q
;
EOJ ; END OF JOB
D ^ACDKILL
Q
ACDDEM ;IHS/ADC/EDE/KML - DATA ENTRY EDIT MODE;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
+3 ;This is the data entry edit driver routine for CDMIS. This
+4 ;routine will ask for COMPONENT CODE/TYPE, then loop within
+5 ;that component asking for TYPE CONTACT, and then if patient
+6 ;related it will ask for patient and then date. If not patient
+7 ;related it will ask for date. Once a visit is selected the
+8 ;user will be able to optionally edit the visit and then the
+9 ;subordinate file entries attached to the visit.
+10 ;
EDIT ; EP - EDIT CDMIS FORMS
+1 SET ACDMODE="E"
+2 DO MAIN
+3 QUIT
+4 ;
MAIN ; MAINLINE LOGIC
+1 DO INIT^ACDDE2
+2 IF ACDQ
DO EOJ
QUIT
+3 ; loop within component code/type
FOR
DO LOOP
IF ACDQ
QUIT
+4 DO EOJ
+5 QUIT
+6 ;
LOOP ; LOOP WITHIN COMPONENT CODE/TYPE
+1 SET ACDLPTYP=1
+2 SET (ACDPROV,ACDPROVN)=""
+3 SET (ACDCONT,ACDCONTL)=""
+4 SET (ACDVDTI,ACDVDTE)=""
+5 SET (ACDDFN,ACDDFNP)=""
+6 DO HDR^ACDDEU
+7 SET ACDNODEF=1
+8 ; get type contact
DO GETTC^ACDDE2
+9 IF ACDQ
QUIT
+10 IF ACDCONT'="IR"
IF ACDCONT'="OT"
DO GETPAT
+11 IF ACDQ
QUIT
+12 DO VISIT
+13 SET ACDQ=0
+14 QUIT
+15 ;
GETPAT ; GET PATIENT
+1 SET ACDQ=1
+2 SET AUPNLK("ALL")=1
+3 SET DIC="^AUPNPAT("
SET DIC(0)="AEMQ"
SET DIC("S")="I $D(^ACDVIS(""D"",+Y))"
DO DIC^ACDFMC
+4 KILL AUPNLK("ALL")
+5 IF Y<0
QUIT
+6 SET ACDDFNP=+Y
SET ACDDFN=$PIECE(^DPT(ACDDFNP,0),U)
+7 SET ACDQ=0
+8 QUIT
+9 ;
VISIT ; EDIT VISIT AND SUBORDINATE FILE ENTRIES
+1 SET DIC="^ACDVIS("
SET DIC(0)="AMQ"
SET DIC("S")="I $P(^ACDVIS(+Y,0),U,2)=ACDCOMC,$P(^(0),U,7)=ACDCOMT,$P(^(0),U,4)=ACDCONT,'$P(^(0),U,25),$P(^(""BWP""),U)=ACDPGM"
IF ACDDFNP
SET DIC("S")=DIC("S")_",$D(^ACDVIS(""D"",ACDDFNP,+Y))"
+2 DO DIC^ACDFMC
+3 IF Y<0
QUIT
+4 SET ACDVIEN=+Y
+5 IF (ACDFHCP+ACDFPCC)
IF $GET(ACDDFNP)
IF ACDVIEN
SET ACDPCCL(ACDDFNP,ACDVIEN)=""
+6 WRITE !
+7 DO DSPVSIT^ACDDEU(ACDVIEN)
+8 SET DIR(0)="Y"
SET DIR("A")="Do you want to edit the visit record"
SET DIR("B")="NO"
KILL DA
DO ^DIR
KILL DIR
+9 ; go edit the visit record itself
IF Y
DO EDVISIT
+10 ; go edit files based on type contact
DO EDTTC
+11 IF ACDFHCP
IF $GET(ACDDFNP)
IF $DATA(ACDPCCL(ACDDFNP))
DO SAVBILL^ACDDE
+12 IF ACDFPCC
IF $GET(ACDDFNP)
IF $DATA(ACDPCCL(ACDDFNP))
DO ^ACDPCCL
+13 QUIT
+14 ;
EDVISIT ; EDIT CDMIS VISIT RECORD
+1 IF (ACDFHCP+ACDFPCC)
IF $GET(ACDDFNP)
IF ACDVIEN
SET ACDPCCL(ACDDFNP,ACDVIEN)=1
+2 SET DIE="^ACDVIS("
SET DR="[ACD VISIT EDIT]"
SET DA=ACDVIEN
+3 DO DIE^ACDFMC
+4 QUIT
+5 ;
EDTTC ; EDIT FILES BASED ON TYPE CONTACT
+1 WRITE !
+2 DO @("EDT"_ACDCONT)
+3 QUIT
+4 ;
EDTIN ; EDIT INITIAL
+1 ; edit CDMIS INIT/INFO/FU
DO EDTIIF
+2 QUIT
+3 ;
EDTRE ; EDIT REOPEN
+1 ; edit CDMIS INIT/INFO/FU
DO EDTIIF
+2 QUIT
+3 ;
EDTFU ; EDIT FOLLOWUP
+1 ; edit CDMIS INIT/INFO/FU
DO EDTIIF
+2 QUIT
+3 ;
EDTTD ; EDIT TRANS/DISC/CLOSE
+1 ; edit CDMIS TRANS/DISC/CLOSE
DO EDTTDC
+2 QUIT
+3 ;
EDTCS ; EDIT CLIENT SERVICE
+1 ; select client service to edit
DO SLCTCS
+2 IF 'ACDCEIEN
QUIT
+3 SET DIR(0)="SO^E:Edit;D:Delete"
SET DIR("B")="Edit"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
QUIT
+5 IF (ACDFHCP+ACDFPCC)
IF $GET(ACDDFNP)
SET ACDPCCL(ACDDFNP,ACDVIEN,"CS",ACDCEIEN)=$SELECT(Y="D":"D",1:"")
+6 IF Y="D"
SET DIK="^ACDCS("
SET DA=ACDCEIEN
DO DIK^ACDFMC
QUIT
+7 SET DIE="^ACDCS("
SET DR="[ACD CLIENT SVCS EDIT]"
SET DA=ACDCEIEN
+8 DO DIE^ACDFMC
+9 QUIT
+10 ;
SLCTCS ; SELECT ONE CS ENTRY
+1 SET ACDCEIEN=0
+2 KILL ^TMP("ACD",$JOB,"CS"),ACDDDAY
+3 SET ACDVDATE=$PIECE(^ACDVIS(ACDVIEN,0),U)
+4 SET (ACDCSC,Y)=0
+5 FOR
SET Y=$ORDER(^ACDCS("C",ACDVIEN,Y))
IF 'Y
QUIT
SET X=^ACDCS(Y,0)
SET ^TMP("ACD",$JOB,"CS",$PIECE(X,U),Y)=$PIECE(X,U,2)
SET X=$PIECE(X,U)
IF '$DATA(ACDDDAY("DAY",X))
Begin DoDot:1
+6 NEW Y
+7 SET ACDCSC=ACDCSC+1
SET ACDDDAY(ACDCSC)=X
SET Y=ACDVDATE
SET Y=Y+X
+8 DO DD^%DT
+9 SET ACDDDAY("DAY",X)=" <"_Y_">"
+10 QUIT
End DoDot:1
+11 SET ACDCSCUT=(ACDCSC\2)+(ACDCSC#2)
+12 FOR I=1:1
IF I>ACDCSCUT
QUIT
SET X=ACDDDAY(I)
WRITE !?5,I_") DAY "_$JUSTIFY(X,2)_ACDDDAY("DAY",X)
SET J=I+ACDCSCUT
IF $DATA(ACDDDAY(J))
SET X=ACDDDAY(J)
WRITE ?40,J_") DAY "_$JUSTIFY(X,2)_ACDDDAY("DAY",X)
+13 WRITE !
+14 SET DIR(0)="NO^1:"_ACDCSC_":0"
SET DIR("A")="Select one CS day"
DO ^DIR
KILL DIR
+15 IF $DATA(DIRUT)
QUIT
+16 SET ACDCSDAY=ACDDDAY(Y)
+17 KILL ACDVDATE,ACDDDAY
+18 KILL ACDX
+19 SET DIR(0)="SO^"
+20 SET ACDLC=0
SET W=ACDCSDAY
SET Y=0
FOR
SET Y=$ORDER(^TMP("ACD",$JOB,"CS",W,Y))
IF 'Y
QUIT
SET ACDLC=ACDLC+1
SET X=^ACDCS(Y,0)
SET Z=$PIECE(X,U,2)
SET X=+X
DO PFTV^XBPFTV(9002170.6,Z,.Z)
SET DIR(0)=DIR(0)_$SELECT($LENGTH(DIR(0))=3:"",1:";")_ACDLC_":"_X_" "_Z
SET ACDX(ACDLC)=Y
+21 KILL ACDCSDAY,ACDLC,^TMP("ACD",$JOB,"CS")
+22 SET DIR("A")="Select one Client Service Entry"
+23 KILL DA
DO ^DIR
KILL DIR
+24 IF $DATA(DIRUT)
QUIT
+25 SET ACDCEIEN=ACDX(Y)
+26 QUIT
+27 ;
EDTOT ; EDIT CRISIS/BRIED INT
+1 ; edit CDMIS INIT/INFO/FU
DO EDTIIF
+2 QUIT
+3 ;
EDTIR ; EDIT INFO/REFERRAL
+1 ; edit CDMIS INIT/INFO/FU
DO EDTIIF
+2 QUIT
+3 ;
EDTIIF ; EDIT CDMIS INIT/INFO/FU
+1 SET DA=$ORDER(^ACDIIF("C",ACDVIEN,0))
+2 IF 'DA
WRITE !,IORVON,"No CDMIS INIT/INFO/FU entry associated with this visit!",IORVOFF,!
QUIT
+3 IF (ACDFHCP+ACDFPCC)
IF $GET(ACDDFNP)
SET ACDPCCL(ACDDFNP,ACDVIEN,"IIF",DA)=""
+4 SET DIE="^ACDIIF("
SET DR="[ACD INIT/INFO/FU EDIT]"
+5 DO DIE^ACDFMC
+6 QUIT
+7 ;
EDTTDC ; EDIT CDMIS TRANS/DISC/CLOSE
+1 SET DA=$ORDER(^ACDTDC("C",ACDVIEN,0))
+2 IF 'DA
WRITE !,IORVON,"No CDMIS TRANS/DISC/CLOSE entry associated with this visit!",IORVOFF,!
QUIT
+3 IF (ACDFHCP+ACDFPCC)
IF $GET(ACDDFNP)
SET ACDPCCL(ACDDFNP,ACDVIEN,"TDC",DA)=""
+4 SET DIE="^ACDTDC("
SET DR="[ACD TRANS/DISC/CLOSE EDIT]"
+5 DO DIE^ACDFMC
+6 QUIT
+7 ;
EOJ ; END OF JOB
+1 DO ^ACDKILL
+2 QUIT
