ACDDE3 ;IHS/ADC/EDE/KML - CDMIS DE - CONTACT TYPES;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
ADDIN ; EP - ADD INITIAL
; ADD MODE
S ACDINR=0
D CHKFIN ; check for INITIAL
Q:ACDQ
D GENVSIT ; generate CDMIS VISIT
Q:ACDQ
D GENIIF^ACDDE3B ; generate CDMIS INIT/INFO/FU
Q:ACDQ
D FACE ; print face sheet if wanted
Q
;
ADDRE ; EP - ADD REOPEN
; ADD MODE
S ACDINR=1
D CHKFIN ; check for INITIAL
Q:ACDQ
D CHKRE^ACDDE3A ; logical check
Q:ACDQ
D GENVSIT ; generate CDMIS VISIT
Q:ACDQ
D GENIIF^ACDDE3B ; generate CDMIS INIT/INFO/FU
Q:ACDQ
D FACE ; print face sheet if wanted
Q
;
ADDFU ; EP - ADD FOLLOWUP
; ADD MODE
S ACDINR=1
D CHKFIN ; check for INITIAL
Q:ACDQ
D CHKFU^ACDDE3A ; logical check
Q:ACDQ
S DIR(0)="9002172.1,3.5",DIR("A")="Enter Follow-up Months" K DA D ^DIR K DIR
S ACDFUM=Y
D GENVSIT ; generate CDMIS VISIT
Q:ACDQ
D GENIIF^ACDDE3B ; generate CDMIS INIT/INFO/FU
Q
;
ADDTD ; EP - ADD TRANS/DISC/CLOSE
; ADD MODE
S ACDINR=1
D CHKFIN ; check for INITIAL
Q:ACDQ
D CHKTD^ACDDE3A ; logical check
Q:ACDQ
D GENVSIT ; generate CDMIS VISIT
Q:ACDQ
D GENTDC^ACDDE3B ; generate CDMIS TRANS/DISC/CLOSE
Q:ACDQ
D FACE ; print face sheet if wanted
Q
;
ADDCS ; EP - ADD CLIENT SERVICE
; ADD MODE
K ACDDECSN
S ACDINR=1
D CHKFIN ; check for INITIAL
Q:ACDQ
D CHKCS^ACDDE3A ; logical check
Q:ACDQ
D ADDCS2 ; get/gen CDMIS VISIT
Q:ACDQ
D GENCS^ACDDE3B ; generate CDMIS CLIENT SVCS
Q
;
ADDCS2 ; EP - GET CS VISIT OR GENERATE A NEW ONE
S ACDY=0
I $D(^TMP("ACD",$J,"VISITS",ACDVDTI)) S ACDY=0 F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDVDTI,ACDY)) Q:'ACDY D Q:ACDQ
. S X=^ACDVIS(ACDY,0)
. I $P(X,U,2)=ACDCOMC,$P(X,U,7)=ACDCOMT,$P(X,U,4)="CS" S ACDQ=1 Q
. Q
S ACDQ=0
I ACDY S ACDVIEN=ACDY D Q ; CS visit already exists
. S ACDPROV=$P(^ACDVIS(ACDVIEN,0),U,3)
.;D PFTV^XBPFTV(6,ACDPROV,.ACDPROVN)
. S ACDPROVN=$P($G(^VA(200,ACDPROV,0)),U)
. S ^TMP("ACD",$J,"PRI PROV")=ACDPROVN
. ;D DSPCSH
. Q
; will get here only if CS visit does not exist
D GENVSIT ; generate CDMIS VISIT
S:ACDVIEN ACDDECSN=ACDVIEN ; set new CS visit flag
Q
;
DSPCSH ; DISPLAY CLIENT SVC HISTORY FOR THIS CS VISIT
Q:'$O(^ACDCS("C",ACDVIEN,0))
W !,"CLIENT SVCS history for this CS VISIT",!,"----------",!
K ACDPTBL
S Y=0
F S Y=$O(^ACDCS("C",ACDVIEN,Y)) Q:'Y S X=^ACDCS(Y,0),ACDPTBL($P(X,U),Y)=$P(X,U,2)
S Y=0
F S Y=$O(ACDPTBL(Y)) Q:'Y S Z=0 F S Z=$O(ACDPTBL(Y,Z)) Q:'Z S X=ACDPTBL(Y,Z) D PFTV^XBPFTV(9002170.6,X,.ACDX) W Y,?5,ACDX,!
K ACDPTBL
W "----------",!
Q
;
ADDOT ; EP - ADD CRISIS/BRIEF INT
D GENVSIT ; generate CDMIS VISIT
Q:ACDQ
D GENIIF^ACDDE3B ; generate CDMIS INIT/INFO/FU
Q
;
ADDIR ; EP - ADD INFO/REFERRAL
D GENVSIT ; generate CDMIS VISIT
Q:ACDQ
D GENIIF^ACDDE3B ; generate CDMIS INIT/INFO/FU
Q
;
CHKFIN ; CHECK FOR INITIAL CONTACT TYPE
D CHKFIN^ACDDEU
Q
;
GENVSIT ; GENERATE NEW CDMIS VISIT
S ACDQ=0,ACDVIEN=0
D GENVSIT2 ; set DR based on contact type
Q:ACDQ
S ACDQ=1
S DIC="^ACDVIS(",DIC(0)="L",DLAYGO=9002172.1,X=ACDVDTI
D FILE^ACDFMC
I +Y<0 W !,IORVON,"Creation of CDMIS VISIT record failed. Notify programmer.",IORVOFF,!! S ACDQ=1 S:$D(^%ZOSF("$ZE")) X="CDMIS VISIT",@^("$ZE") D @^%ZOSF("ERRTN") D PAUSE^ACDDEU Q
S ACDVIEN=+Y
W !!
W $$VAL^XBDIQ1(9002172.1,ACDVIEN,.01)," - ",$$VAL^XBDIQ1(9002172.1,ACDVIEN,1),"/",$$VAL^XBDIQ1(9002172.1,ACDVIEN,5)," ",$$VAL^XBDIQ1(9002172.1,ACDVIEN,3),!
S DIR(0)="Y",DIR("A")="Accept visit as generated",DIR("B")="Y" K DA D ^DIR K DIR
I 'Y S DIK="^ACDVIS(",DA=ACDVIEN D DIK^ACDFMC K:$G(ACDDFNP) ^TMP("ACD",$J,"PAT",ACDDFNP) S ACDVIEN=0 Q
I (ACDFHCP+ACDFPCC),$G(ACDDFNP),ACDVIEN S ACDPCCL(ACDDFNP,ACDVIEN)=""
S ACDQ=0
Q
;
GENVSIT2 ; SET DR BASED ON CONTACT TYPE
; if IR or OT set and quit
I ACDCONT="IR"!(ACDCONT="OT") D Q
. S DIC("DR")="1////"_ACDCOMC_";2////"_ACDPROV_";3////"_ACDCONT_";5////"_ACDCOMT_";99.99////"_ACDPGM_";1102////"_DUZ
. Q ; Wilbur says to remove FT name
. Q:ACDCONT'="OT"
. D CBNAME
. Q:X=""
. S DIC("DR")=DIC("DR")_"26////"_X
. Q
; set for other than IR or OT
I ACDCONT="CS" D GETPROV^ACDDE2 ; get primary provider
Q:ACDQ
S DIC("DR")="1////"_ACDCOMC_";2////"_ACDPROV_";3////"_ACDCONT
I ACDCONT="FU",ACDFUM]"" S DIC("DR")=DIC("DR")_";3.5////"_ACDFUM
S DIC("DR")=DIC("DR")_";4////"_ACDDFNP_";5////"_ACDCOMT_";9////"_ACDAGER_";99.99////"_ACDPGM_";1102////"_DUZ
S DIC("DR")=DIC("DR")_";101////"_ACDTRBCD_";102////"_ACDSTACD_";103////"_$E(ACDSEX)_";104////"_$E(ACDVET)_";105////"_ACDTRB_";106////"_ACDSTA_";107////"_ACDAGE
Q
;
CBNAME ; GET NAME FOR CRISIS BRIEF
S DIR(0)="9002172.1,26",DIR("A")="Enter patient name for Crisis Brief" K DA D ^DIR K DIR
S:X["^" (X,Y)=""
Q
;
FACE ; PRINT FACE SHEED IF WANTED
Q:'$D(ACDVIEN) ; quit if no visit
I '$G(ACDIIEN),(ACDCONT="IN"!(ACDCONT="RE")) Q
I ACDCONT="TD",'$G(ACDTDC) Q ; quit if TD and no TDC entry
W !
S DIR(0)="Y",DIR("A")="Print Face Sheet",DIR("B")="Y" K DA D ^DIR K DIR
Q:'Y
D DEV^ACDDEU
Q:ACDQ
D DISPLAY^ACDPFACE,PAUSE^ACDDEU
Q
ACDDE3 ;IHS/ADC/EDE/KML - CDMIS DE - CONTACT TYPES;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
ADDIN ; EP - ADD INITIAL
+1 ; ADD MODE
+2 SET ACDINR=0
+3 ; check for INITIAL
DO CHKFIN
+4 IF ACDQ
QUIT
+5 ; generate CDMIS VISIT
DO GENVSIT
+6 IF ACDQ
QUIT
+7 ; generate CDMIS INIT/INFO/FU
DO GENIIF^ACDDE3B
+8 IF ACDQ
QUIT
+9 ; print face sheet if wanted
DO FACE
+10 QUIT
+11 ;
ADDRE ; EP - ADD REOPEN
+1 ; ADD MODE
+2 SET ACDINR=1
+3 ; check for INITIAL
DO CHKFIN
+4 IF ACDQ
QUIT
+5 ; logical check
DO CHKRE^ACDDE3A
+6 IF ACDQ
QUIT
+7 ; generate CDMIS VISIT
DO GENVSIT
+8 IF ACDQ
QUIT
+9 ; generate CDMIS INIT/INFO/FU
DO GENIIF^ACDDE3B
+10 IF ACDQ
QUIT
+11 ; print face sheet if wanted
DO FACE
+12 QUIT
+13 ;
ADDFU ; EP - ADD FOLLOWUP
+1 ; ADD MODE
+2 SET ACDINR=1
+3 ; check for INITIAL
DO CHKFIN
+4 IF ACDQ
QUIT
+5 ; logical check
DO CHKFU^ACDDE3A
+6 IF ACDQ
QUIT
+7 SET DIR(0)="9002172.1,3.5"
SET DIR("A")="Enter Follow-up Months"
KILL DA
DO ^DIR
KILL DIR
+8 SET ACDFUM=Y
+9 ; generate CDMIS VISIT
DO GENVSIT
+10 IF ACDQ
QUIT
+11 ; generate CDMIS INIT/INFO/FU
DO GENIIF^ACDDE3B
+12 QUIT
+13 ;
ADDTD ; EP - ADD TRANS/DISC/CLOSE
+1 ; ADD MODE
+2 SET ACDINR=1
+3 ; check for INITIAL
DO CHKFIN
+4 IF ACDQ
QUIT
+5 ; logical check
DO CHKTD^ACDDE3A
+6 IF ACDQ
QUIT
+7 ; generate CDMIS VISIT
DO GENVSIT
+8 IF ACDQ
QUIT
+9 ; generate CDMIS TRANS/DISC/CLOSE
DO GENTDC^ACDDE3B
+10 IF ACDQ
QUIT
+11 ; print face sheet if wanted
DO FACE
+12 QUIT
+13 ;
ADDCS ; EP - ADD CLIENT SERVICE
+1 ; ADD MODE
+2 KILL ACDDECSN
+3 SET ACDINR=1
+4 ; check for INITIAL
DO CHKFIN
+5 IF ACDQ
QUIT
+6 ; logical check
DO CHKCS^ACDDE3A
+7 IF ACDQ
QUIT
+8 ; get/gen CDMIS VISIT
DO ADDCS2
+9 IF ACDQ
QUIT
+10 ; generate CDMIS CLIENT SVCS
DO GENCS^ACDDE3B
+11 QUIT
+12 ;
ADDCS2 ; EP - GET CS VISIT OR GENERATE A NEW ONE
+1 SET ACDY=0
+2 IF $DATA(^TMP("ACD",$JOB,"VISITS",ACDVDTI))
SET ACDY=0
FOR
SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDVDTI,ACDY))
IF 'ACDY
QUIT
Begin DoDot:1
+3 SET X=^ACDVIS(ACDY,0)
+4 IF $PIECE(X,U,2)=ACDCOMC
IF $PIECE(X,U,7)=ACDCOMT
IF $PIECE(X,U,4)="CS"
SET ACDQ=1
QUIT
+5 QUIT
End DoDot:1
IF ACDQ
QUIT
+6 SET ACDQ=0
+7 ; CS visit already exists
IF ACDY
SET ACDVIEN=ACDY
Begin DoDot:1
+8 SET ACDPROV=$PIECE(^ACDVIS(ACDVIEN,0),U,3)
+9 ;D PFTV^XBPFTV(6,ACDPROV,.ACDPROVN)
+10 SET ACDPROVN=$PIECE($GET(^VA(200,ACDPROV,0)),U)
+11 SET ^TMP("ACD",$JOB,"PRI PROV")=ACDPROVN
+12 ;D DSPCSH
+13 QUIT
End DoDot:1
QUIT
+14 ; will get here only if CS visit does not exist
+15 ; generate CDMIS VISIT
DO GENVSIT
+16 ; set new CS visit flag
IF ACDVIEN
SET ACDDECSN=ACDVIEN
+17 QUIT
+18 ;
DSPCSH ; DISPLAY CLIENT SVC HISTORY FOR THIS CS VISIT
+1 IF '$ORDER(^ACDCS("C",ACDVIEN,0))
QUIT
+2 WRITE !,"CLIENT SVCS history for this CS VISIT",!,"----------",!
+3 KILL ACDPTBL
+4 SET Y=0
+5 FOR
SET Y=$ORDER(^ACDCS("C",ACDVIEN,Y))
IF 'Y
QUIT
SET X=^ACDCS(Y,0)
SET ACDPTBL($PIECE(X,U),Y)=$PIECE(X,U,2)
+6 SET Y=0
+7 FOR
SET Y=$ORDER(ACDPTBL(Y))
IF 'Y
QUIT
SET Z=0
FOR
SET Z=$ORDER(ACDPTBL(Y,Z))
IF 'Z
QUIT
SET X=ACDPTBL(Y,Z)
DO PFTV^XBPFTV(9002170.6,X,.ACDX)
WRITE Y,?5,ACDX,!
+8 KILL ACDPTBL
+9 WRITE "----------",!
+10 QUIT
+11 ;
ADDOT ; EP - ADD CRISIS/BRIEF INT
+1 ; generate CDMIS VISIT
DO GENVSIT
+2 IF ACDQ
QUIT
+3 ; generate CDMIS INIT/INFO/FU
DO GENIIF^ACDDE3B
+4 QUIT
+5 ;
ADDIR ; EP - ADD INFO/REFERRAL
+1 ; generate CDMIS VISIT
DO GENVSIT
+2 IF ACDQ
QUIT
+3 ; generate CDMIS INIT/INFO/FU
DO GENIIF^ACDDE3B
+4 QUIT
+5 ;
CHKFIN ; CHECK FOR INITIAL CONTACT TYPE
+1 DO CHKFIN^ACDDEU
+2 QUIT
+3 ;
GENVSIT ; GENERATE NEW CDMIS VISIT
+1 SET ACDQ=0
SET ACDVIEN=0
+2 ; set DR based on contact type
DO GENVSIT2
+3 IF ACDQ
QUIT
+4 SET ACDQ=1
+5 SET DIC="^ACDVIS("
SET DIC(0)="L"
SET DLAYGO=9002172.1
SET X=ACDVDTI
+6 DO FILE^ACDFMC
+7 IF +Y<0
WRITE !,IORVON,"Creation of CDMIS VISIT record failed. Notify programmer.",IORVOFF,!!
SET ACDQ=1
IF $DATA(^%ZOSF("$ZE"))
SET X="CDMIS VISIT"
SET @^("$ZE")
DO @^%ZOSF("ERRTN")
DO PAUSE^ACDDEU
QUIT
+8 SET ACDVIEN=+Y
+9 WRITE !!
+10 WRITE $$VAL^XBDIQ1(9002172.1,ACDVIEN,.01)," - ",$$VAL^XBDIQ1(9002172.1,ACDVIEN,1),"/",$$VAL^XBDIQ1(9002172.1,ACDVIEN,5)," ",$$VAL^XBDIQ1(9002172.1,ACDVIEN,3),!
+11 SET DIR(0)="Y"
SET DIR("A")="Accept visit as generated"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+12 IF 'Y
SET DIK="^ACDVIS("
SET DA=ACDVIEN
DO DIK^ACDFMC
IF $GET(ACDDFNP)
KILL ^TMP("ACD",$JOB,"PAT",ACDDFNP)
SET ACDVIEN=0
QUIT
+13 IF (ACDFHCP+ACDFPCC)
IF $GET(ACDDFNP)
IF ACDVIEN
SET ACDPCCL(ACDDFNP,ACDVIEN)=""
+14 SET ACDQ=0
+15 QUIT
+16 ;
GENVSIT2 ; SET DR BASED ON CONTACT TYPE
+1 ; if IR or OT set and quit
+2 IF ACDCONT="IR"!(ACDCONT="OT")
Begin DoDot:1
+3 SET DIC("DR")="1////"_ACDCOMC_";2////"_ACDPROV_";3////"_ACDCONT_";5////"_ACDCOMT_";99.99////"_ACDPGM_";1102////"_DUZ
+4 ; Wilbur says to remove FT name
QUIT
+5 IF ACDCONT'="OT"
QUIT
+6 DO CBNAME
+7 IF X=""
QUIT
+8 SET DIC("DR")=DIC("DR")_"26////"_X
+9 QUIT
End DoDot:1
QUIT
+10 ; set for other than IR or OT
+11 ; get primary provider
IF ACDCONT="CS"
DO GETPROV^ACDDE2
+12 IF ACDQ
QUIT
+13 SET DIC("DR")="1////"_ACDCOMC_";2////"_ACDPROV_";3////"_ACDCONT
+14 IF ACDCONT="FU"
IF ACDFUM]""
SET DIC("DR")=DIC("DR")_";3.5////"_ACDFUM
+15 SET DIC("DR")=DIC("DR")_";4////"_ACDDFNP_";5////"_ACDCOMT_";9////"_ACDAGER_";99.99////"_ACDPGM_";1102////"_DUZ
+16 SET DIC("DR")=DIC("DR")_";101////"_ACDTRBCD_";102////"_ACDSTACD_";103////"_$EXTRACT(ACDSEX)_";104////"_$EXTRACT(ACDVET)_";105////"_ACDTRB_";106////"_ACDSTA_";107////"_ACDAGE
+17 QUIT
+18 ;
CBNAME ; GET NAME FOR CRISIS BRIEF
+1 SET DIR(0)="9002172.1,26"
SET DIR("A")="Enter patient name for Crisis Brief"
KILL DA
DO ^DIR
KILL DIR
+2 IF X["^"
SET (X,Y)=""
+3 QUIT
+4 ;
FACE ; PRINT FACE SHEED IF WANTED
+1 ; quit if no visit
IF '$DATA(ACDVIEN)
QUIT
+2 IF '$GET(ACDIIEN)
IF (ACDCONT="IN"!(ACDCONT="RE"))
QUIT
+3 ; quit if TD and no TDC entry
IF ACDCONT="TD"
IF '$GET(ACDTDC)
QUIT
+4 WRITE !
+5 SET DIR(0)="Y"
SET DIR("A")="Print Face Sheet"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+6 IF 'Y
QUIT
+7 DO DEV^ACDDEU
+8 IF ACDQ
QUIT
+9 DO DISPLAY^ACDPFACE
DO PAUSE^ACDDEU
+10 QUIT
