ACDDE ;IHS/ADC/EDE/KML - CDMIS DATA ENTRY;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
;This is the data entry driver routine for CDMIS. This
;routine will ask for COMPONENT CODE/TYPE, then for TYPE CONTACT,
;then for PROVIDER if not CS, then VISIT DATE. The form of the
;date will vary based on TYPE CONTACT. If client/patient
;related the client/patient is then selected. In any case,
;control is then passed to the appropriate INPUT TEMPLATE for
;that TYPE CONTACT.
;
Q ; cannot enter from top
;
ADD ; EP - ADD CDMIS FORMS
S ACDMODE="A"
D MAIN
Q
;
MAIN ; MAINLINE LOGIC
D INIT^ACDDE2
I ACDQ D EOJ Q
F D OUTERLP Q:ACDQ ; loop at outer level (for CS)
D EOJ
Q
;
OUTERLP ; OUTER LOOP FOR CS (NO PRIMARY PROVIDER)
S ACDLPTYP=1
S (ACDCONT,ACDCONTL)=""
D HDR^ACDDEU
D GETTC^ACDDE2 ; get type contact
Q:ACDQ
I ACDCONT="CS" D F D DATELP Q:ACDQ ;loop at date level
. S DIC=6,DIC(0)="AEMQZ",DIC("A")="Enter default provider to credit workload: " D DIC^ACDFMC
. Q:Y<0
. S ACDCSDP=Y(0,0) ; save name of default provider
. Q
Q:ACDQ
S ACDBYPAS=1
F D PROVLP Q:ACDQ ; loop at provider level
Q
;
PROVLP ; LOOP AT PROVIDER LEVEL
S (ACDPROV,ACDPROVN)=""
D HDR^ACDDEU
D GETPROV^ACDDE2 ; get primary provider
Q:ACDQ
F D TCDLP Q:ACDQ ; loop at type contact and date level
S ACDQ=0
Q
;
TCDLP ; LOOP AT TYPE CONTACT AND DATE LEVEL
S:'$G(ACDBYPAS) (ACDCONT,ACDCONTL)=""
S (ACDVDTI,ACDVDTE)=""
D HDR^ACDDEU
D:'$G(ACDBYPAS) GETTC^ACDDE2 ; get type contact
K ACDBYPAS
Q:ACDQ
S:ACDCONT="CS" ACDCSDP=ACDPROVN ; set name of default provider
Q:ACDQ
D GETVDATE^ACDDE2 ; get visit date
Q:ACDQ
; IR and OT not patient related so do and get out
I ACDCONT="IR" D ADDTC Q
I ACDCONT="OT" D ADDTC Q
F D PATLP Q:ACDQ ; loop at patient level
S ACDQ=0
Q
;
DATELP ; LOOP AT DATE LEVEL FOR CS ONLY
S ACDLPTYP=2
S (ACDVDTI,ACDVDTE)=""
D HDR^ACDDEU
D GETVDATE^ACDDE2 ; get visit date
Q:ACDQ
F D PATLP Q:ACDQ ; loop at patient level
S ACDQ=0
Q
;
PATLP ; LOOP AT PATIENT LEVEL
D HDR^ACDDEU
S ACDQ=1
D ^ACDDEGP ; get patient
Q:ACDQ
D GETVSITS^ACDDEU ; gather all cdmis visits for this client
D ADDTC ; add data based on type contact
I ACDQ,'$D(DTOUT),'$D(DUOUT) D:ACDQ=1 DSPHIST^ACDDEU,PAUSE^ACDDEU Q
I ACDCONT="IN"!(ACDCONT="TD")!(ACDCONT="RE") S ACDQ=1
Q
;
ADDTC ; ADD DATA BASED ON TYPE CONTACT
S ACDVIEN=0
D @("ADD"_ACDCONT_"^ACDDE3")
Q:'ACDVIEN
; Do not delete visit if timed out and contact type is CS
I ACDVIEN,ACDCONT'="CS",$D(DTOUT) S ACDVISP=ACDVIEN D AUTO^ACDDIK Q
S ACDVISP=ACDVIEN
D CHK
I ACDFHCP,$G(ACDDFNP),$D(ACDPCCL(ACDDFNP)) D SAVBILL
I ACDFPCC,$G(ACDDFNP),$D(ACDPCCL(ACDDFNP)) D ^ACDPCCL
Q
;
CHK ;
NEW ACDVIEN
I $G(ACDDFNP) S X=ACDDFNP NEW ACDDFNP S ACDDFNP=X
Q:'$D(ACDVISP)
K ACDTOUT
I $O(^ACDIIF("C",ACDVISP,0)) Q ; quit if entry in ^ACDIIF
;
;If the visit was a 'TDC' ask user to duplicate with an
;initial or re-open visit
I $O(^ACDTDC("C",ACDVISP,0)) NEW ACDCONT,ACDCOMC,ACDCOMT D EN^ACDAUTO Q
;
;If the visit was a new client service visit or an old client
;service visit to which client services were added then ask
;the user to exactly duplicate them for other patients.
I $G(ACDDECSN)!($D(ACDCS)) D EN^ACDAUTO1 Q
;
Q:ACDCONT="CS" ; allow a CS visit with no CS entries
; if I get here visit is incomplete
S ACDTOUT=1 K:((ACDFHCP+ACDFPCC)&($G(ACDDFNP))) ACDPCCL(ACDDFNP,ACDVISP) D AUTO^ACDDIK
Q
;
SAVBILL ; EP-SAVE DATA FOR BILLING
; Note - should get here once for each CDMIS VISIT
; Local array set as CDMIS entries added or edited:
; ACDPCCL(patient ien,visit ien)=""
; ACDPCCL(patient ien,visit ien,"CS",cs ien)=""
; ACDPCCL(patient ien,visit ien,"IIF",iif ien)=""
; ACDPCCL(patient ien,visit ien,"TDC",tdc ien)=""
;
D SAVBILL2
I 'ACDFPCC K ACDPCCL(ACDDFNP,ACDVIEN)
Q
;
SAVBILL2 ;
I ACDFHCPT,'$D(ACDFHCPT(ACDCOMC)) Q ; quit if not wanted component
NEW ACDBFT,ACDBIEN,ACDCSIEN
S ACDBFT=$S(ACDCONT="CS":3,ACDCONT="TD":2,1:1)
I '$O(ACDPCCL(ACDDFNP,ACDVIEN,$S(ACDBFT=3:"CS",ACDBFT=2:"TDC",1:"IIF"),0)) Q ; should never happen
S X=DT,DIC="^ACDBILL(",DIC(0)="L",DIC("DR")=".02////"_ACDDFNP_";.03////"_ACDBFT_";.04////"_ACDVIEN_$S(ACDMODE="E":";.09////1",1:"")
I ACDBFT'=3 S DIC("DR")=DIC("DR")_";"_$S(ACDBFT=2:".06",1:".05")_"////"_$O(ACDPCCL(ACDDFNP,ACDVIEN,$S(ACDBFT=2:"TDC",1:"IIF"),0))
D FILE^ACDFMC
I Y<0 W !!,"Adding of CDMIS BILL RECORD failed. Notify programmer.",!! Q
Q:ACDBFT'=3 ; quit if not CS
S ACDBIEN=+Y
S ACDCSIEN=0
F S ACDCSIEN=$O(ACDPCCL(ACDDFNP,ACDVIEN,"CS",ACDCSIEN)) Q:'ACDCSIEN D
. S X=ACDCSIEN,DA(1)=ACDBIEN,DIC="^ACDBILL("_DA(1)_",21,",DIC(0)="L",DIC("P")=$P(^DD(9002172.9,2100,0),U,2)
. D FILE^ACDFMC
. I Y<0 W !!,"Adding of CS pointer failed. Notify programmer.",!! Q
. Q
Q
;
EOJ ; END OF JOB
D ^ACDKILL
Q
ACDDE ;IHS/ADC/EDE/KML - CDMIS DATA ENTRY;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
+3 ;This is the data entry driver routine for CDMIS. This
+4 ;routine will ask for COMPONENT CODE/TYPE, then for TYPE CONTACT,
+5 ;then for PROVIDER if not CS, then VISIT DATE. The form of the
+6 ;date will vary based on TYPE CONTACT. If client/patient
+7 ;related the client/patient is then selected. In any case,
+8 ;control is then passed to the appropriate INPUT TEMPLATE for
+9 ;that TYPE CONTACT.
+10 ;
+11 ; cannot enter from top
QUIT
+12 ;
ADD ; EP - ADD CDMIS FORMS
+1 SET ACDMODE="A"
+2 DO MAIN
+3 QUIT
+4 ;
MAIN ; MAINLINE LOGIC
+1 DO INIT^ACDDE2
+2 IF ACDQ
DO EOJ
QUIT
+3 ; loop at outer level (for CS)
FOR
DO OUTERLP
IF ACDQ
QUIT
+4 DO EOJ
+5 QUIT
+6 ;
OUTERLP ; OUTER LOOP FOR CS (NO PRIMARY PROVIDER)
+1 SET ACDLPTYP=1
+2 SET (ACDCONT,ACDCONTL)=""
+3 DO HDR^ACDDEU
+4 ; get type contact
DO GETTC^ACDDE2
+5 IF ACDQ
QUIT
+6 ;loop at date level
IF ACDCONT="CS"
Begin DoDot:1
+7 SET DIC=6
SET DIC(0)="AEMQZ"
SET DIC("A")="Enter default provider to credit workload: "
DO DIC^ACDFMC
+8 IF Y<0
QUIT
+9 ; save name of default provider
SET ACDCSDP=Y(0,0)
+10 QUIT
End DoDot:1
FOR
DO DATELP
IF ACDQ
QUIT
+11 IF ACDQ
QUIT
+12 SET ACDBYPAS=1
+13 ; loop at provider level
FOR
DO PROVLP
IF ACDQ
QUIT
+14 QUIT
+15 ;
PROVLP ; LOOP AT PROVIDER LEVEL
+1 SET (ACDPROV,ACDPROVN)=""
+2 DO HDR^ACDDEU
+3 ; get primary provider
DO GETPROV^ACDDE2
+4 IF ACDQ
QUIT
+5 ; loop at type contact and date level
FOR
DO TCDLP
IF ACDQ
QUIT
+6 SET ACDQ=0
+7 QUIT
+8 ;
TCDLP ; LOOP AT TYPE CONTACT AND DATE LEVEL
+1 IF '$GET(ACDBYPAS)
SET (ACDCONT,ACDCONTL)=""
+2 SET (ACDVDTI,ACDVDTE)=""
+3 DO HDR^ACDDEU
+4 ; get type contact
IF '$GET(ACDBYPAS)
DO GETTC^ACDDE2
+5 KILL ACDBYPAS
+6 IF ACDQ
QUIT
+7 ; set name of default provider
IF ACDCONT="CS"
SET ACDCSDP=ACDPROVN
+8 IF ACDQ
QUIT
+9 ; get visit date
DO GETVDATE^ACDDE2
+10 IF ACDQ
QUIT
+11 ; IR and OT not patient related so do and get out
+12 IF ACDCONT="IR"
DO ADDTC
QUIT
+13 IF ACDCONT="OT"
DO ADDTC
QUIT
+14 ; loop at patient level
FOR
DO PATLP
IF ACDQ
QUIT
+15 SET ACDQ=0
+16 QUIT
+17 ;
DATELP ; LOOP AT DATE LEVEL FOR CS ONLY
+1 SET ACDLPTYP=2
+2 SET (ACDVDTI,ACDVDTE)=""
+3 DO HDR^ACDDEU
+4 ; get visit date
DO GETVDATE^ACDDE2
+5 IF ACDQ
QUIT
+6 ; loop at patient level
FOR
DO PATLP
IF ACDQ
QUIT
+7 SET ACDQ=0
+8 QUIT
+9 ;
PATLP ; LOOP AT PATIENT LEVEL
+1 DO HDR^ACDDEU
+2 SET ACDQ=1
+3 ; get patient
DO ^ACDDEGP
+4 IF ACDQ
QUIT
+5 ; gather all cdmis visits for this client
DO GETVSITS^ACDDEU
+6 ; add data based on type contact
DO ADDTC
+7 IF ACDQ
IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
IF ACDQ=1
DO DSPHIST^ACDDEU
DO PAUSE^ACDDEU
QUIT
+8 IF ACDCONT="IN"!(ACDCONT="TD")!(ACDCONT="RE")
SET ACDQ=1
+9 QUIT
+10 ;
ADDTC ; ADD DATA BASED ON TYPE CONTACT
+1 SET ACDVIEN=0
+2 DO @("ADD"_ACDCONT_"^ACDDE3")
+3 IF 'ACDVIEN
QUIT
+4 ; Do not delete visit if timed out and contact type is CS
+5 IF ACDVIEN
IF ACDCONT'="CS"
IF $DATA(DTOUT)
SET ACDVISP=ACDVIEN
DO AUTO^ACDDIK
QUIT
+6 SET ACDVISP=ACDVIEN
+7 DO CHK
+8 IF ACDFHCP
IF $GET(ACDDFNP)
IF $DATA(ACDPCCL(ACDDFNP))
DO SAVBILL
+9 IF ACDFPCC
IF $GET(ACDDFNP)
IF $DATA(ACDPCCL(ACDDFNP))
DO ^ACDPCCL
+10 QUIT
+11 ;
CHK ;
+1 NEW ACDVIEN
+2 IF $GET(ACDDFNP)
SET X=ACDDFNP
NEW ACDDFNP
SET ACDDFNP=X
+3 IF '$DATA(ACDVISP)
QUIT
+4 KILL ACDTOUT
+5 ; quit if entry in ^ACDIIF
IF $ORDER(^ACDIIF("C",ACDVISP,0))
QUIT
+6 ;
+7 ;If the visit was a 'TDC' ask user to duplicate with an
+8 ;initial or re-open visit
+9 IF $ORDER(^ACDTDC("C",ACDVISP,0))
NEW ACDCONT,ACDCOMC,ACDCOMT
DO EN^ACDAUTO
QUIT
+10 ;
+11 ;If the visit was a new client service visit or an old client
+12 ;service visit to which client services were added then ask
+13 ;the user to exactly duplicate them for other patients.
+14 IF $GET(ACDDECSN)!($DATA(ACDCS))
DO EN^ACDAUTO1
QUIT
+15 ;
+16 ; allow a CS visit with no CS entries
IF ACDCONT="CS"
QUIT
+17 ; if I get here visit is incomplete
+18 SET ACDTOUT=1
IF ((ACDFHCP+ACDFPCC)&($GET(ACDDFNP)))
KILL ACDPCCL(ACDDFNP,ACDVISP)
DO AUTO^ACDDIK
+19 QUIT
+20 ;
SAVBILL ; EP-SAVE DATA FOR BILLING
+1 ; Note - should get here once for each CDMIS VISIT
+2 ; Local array set as CDMIS entries added or edited:
+3 ; ACDPCCL(patient ien,visit ien)=""
+4 ; ACDPCCL(patient ien,visit ien,"CS",cs ien)=""
+5 ; ACDPCCL(patient ien,visit ien,"IIF",iif ien)=""
+6 ; ACDPCCL(patient ien,visit ien,"TDC",tdc ien)=""
+7 ;
+8 DO SAVBILL2
+9 IF 'ACDFPCC
KILL ACDPCCL(ACDDFNP,ACDVIEN)
+10 QUIT
+11 ;
SAVBILL2 ;
+1 ; quit if not wanted component
IF ACDFHCPT
IF '$DATA(ACDFHCPT(ACDCOMC))
QUIT
+2 NEW ACDBFT,ACDBIEN,ACDCSIEN
+3 SET ACDBFT=$SELECT(ACDCONT="CS":3,ACDCONT="TD":2,1:1)
+4 ; should never happen
IF '$ORDER(ACDPCCL(ACDDFNP,ACDVIEN,$SELECT(ACDBFT=3:"CS",ACDBFT=2:"TDC",1:"IIF"),0))
QUIT
+5 SET X=DT
SET DIC="^ACDBILL("
SET DIC(0)="L"
SET DIC("DR")=".02////"_ACDDFNP_";.03////"_ACDBFT_";.04////"_ACDVIEN_$SELECT(ACDMODE="E":";.09////1",1:"")
+6 IF ACDBFT'=3
SET DIC("DR")=DIC("DR")_";"_$SELECT(ACDBFT=2:".06",1:".05")_"////"_$ORDER(ACDPCCL(ACDDFNP,ACDVIEN,$SELECT(ACDBFT=2:"TDC",1:"IIF"),0))
+7 DO FILE^ACDFMC
+8 IF Y<0
WRITE !!,"Adding of CDMIS BILL RECORD failed. Notify programmer.",!!
QUIT
+9 ; quit if not CS
IF ACDBFT'=3
QUIT
+10 SET ACDBIEN=+Y
+11 SET ACDCSIEN=0
+12 FOR
SET ACDCSIEN=$ORDER(ACDPCCL(ACDDFNP,ACDVIEN,"CS",ACDCSIEN))
IF 'ACDCSIEN
QUIT
Begin DoDot:1
+13 SET X=ACDCSIEN
SET DA(1)=ACDBIEN
SET DIC="^ACDBILL("_DA(1)_",21,"
SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(9002172.9,2100,0),U,2)
+14 DO FILE^ACDFMC
+15 IF Y<0
WRITE !!,"Adding of CS pointer failed. Notify programmer.",!!
QUIT
+16 QUIT
End DoDot:1
+17 QUIT
+18 ;
EOJ ; END OF JOB
+1 DO ^ACDKILL
+2 QUIT
