ACDDE3A ;IHS/ADC/EDE/KML - DATA ENTRY/CHECK CONTACT TYPES;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
CHKRE ; EP - CHECK REOPEN
; ADD MODE
; should have been a t/d/c, may have followups
S ACDX="A",ACDQ=0
F S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX),-1) Q:ACDX="" D Q:ACDQ
. Q:ACDX>ACDVDTI ; ignore later dates
. S ACDY="A"
. F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY),-1) 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)="TD" S ACDQ=1 Q
.. Q
. Q:ACDQ
. S ACDY="A"
. F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY),-1) 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)'="FU" S ACDQ=1 Q
.. Q
. Q
S ACDQ=0
I ACDY,$P(X,U,4)'="TD" W !,IORVON,"Last non-followup CDMIS VISIT for component ",ACDCOMCL,"/",ACDCOMTL,!,"on or prior to ",ACDVDTE," was not a TRANS/DISC/CLOSE.",IORVOFF,! D DSPVSIT^ACDDEU(ACDY) D Q
. S DIR(0)="Y",DIR("A")="Do you want to add this CDMIS VISIT anyway",DIR("B")="N" K DA D ^DIR K DIR
. S:'Y ACDQ=1
. Q
S ACDFLG=0
I ACDY S ACDX=ACDX-1 F S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX)) Q:ACDX="" D Q:ACDQ
. S ACDY=+ACDY F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY)) Q:'ACDY D Q:ACDQ
.. S X=^ACDVIS(ACDY,0)
.. I $P(X,U,2)=ACDCOMC,$P(X,U,7)=ACDCOMT D Q
... I $P(X,U,4)="TD" S ACDFLG=1,ACDQ=1 Q
... I $P(X,U,4)="RE" S ACDFLG=2,ACDQ=1 Q
... Q
.. Q
. Q
S ACDQ=0
I ACDFLG W !,IORVON,"Subsequent ",$S(ACDFLG=1:"TRANS/DISC/CLOSE",1:"REOPEN")," CDMIS VISIT for component ",ACDCOMCL,"/",ACDCOMTL,!,"after ",ACDVDTE,".",IORVOFF,! D
. D DSPHIST^ACDDEU
. S DIR(0)="Y",DIR("A")="Do you want to add this CDMIS VISIT anyway",DIR("B")="N" K DA D ^DIR K DIR
. S:'Y ACDQ=2
. Q
Q:ACDQ
Q
;
CHKFU ; EP - CHECK FOLLOWUP
; ADD MODE
; should have been a t/d/c, may have followups
S ACDX=""
F S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX),-1) Q:ACDX="" D Q:ACDQ
. Q:ACDX>ACDVDTI ; ignore later dates
. S ACDY="A"
. F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY),-1) 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)'="FU" S ACDQ=1 Q
.. Q
. Q
S ACDQ=0
I ACDY,$P(X,U,4)'="TD" W !,IORVON,"Last non-followup CDMIS VISIT for component ",ACDCOMCL,"/",ACDCOMTL,!,"was not a TRANS/DISC/CLOSE.",IORVOFF,! D DSPVSIT^ACDDEU(ACDY) D Q
. S DIR(0)="Y",DIR("A")="Do you want to add this CDMIS VISIT anyway",DIR("B")="N" K DA D ^DIR K DIR
. S:'Y ACDQ=1
. Q
Q
;
CHKTD ; EP - CHECK TRANS/DISC/CLOSE
; ADD MODE
; should be initial or reopen with no t/d/c
S ACDX="A"
F S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX),-1) Q:ACDX="" D Q:ACDQ
. Q:ACDX>ACDVDTI ; ignore later dates
. S ACDY="A"
. F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY),-1) 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)="TD"!($P(X,U,4)="IN")!($P(X,U,4)="RE")) S ACDQ=1 Q
.. Q
. Q
S ACDQ=0
I 'ACDY W !,IORVON,"Impossible error in ADDTD^ACDDE. Notify programmer.",IORVOFF,!! S ACDQ=1 S:$D(^%ZOSF("$ZE")) X="CDMIS VISIT",@^("$ZE") D @^%ZOSF("ERRTN") D PAUSE^ACDDEU Q ; should have been caught by CHKFIN
I $P(X,U,4)="TD" W !,IORVON,"There is already a TRANS/DISC/CLOSE CDMIS VISIT for component",!,ACDCOMCL,"/",ACDCOMTL," on or before ",ACDVDTE,".",IORVOFF,! D DSPVSIT^ACDDEU(ACDY),PAUSE^ACDDEU S ACDQ=1 Q
I ACDY S ACDX=ACDX-1 F S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX)) Q:ACDX="" D Q:ACDQ
. S ACDY=+ACDY F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY)) Q:'ACDY D Q:ACDQ
.. S X=^ACDVIS(ACDY,0)
.. I $P(X,U,2)=ACDCOMC,$P(X,U,7)=ACDCOMT D Q
... I $P(X,U,4)="TD" S ACDQ=1 Q
... I $P(X,U,4)="RE" S ACDY=0,ACDQ=1 Q
... Q
.. Q
. Q
S ACDQ=0
I ACDY W !,IORVON,"Subsequent TRANS/DISC/CLOSE CDMIS VISIT for component ",ACDCOMCL,"/",ACDCOMTL,!,"after ",ACDVDTE,".",IORVOFF,! D
. D DSPHIST^ACDDEU
. S DIR(0)="Y",DIR("A")="Do you want to add this CDMIS VISIT anyway",DIR("B")="N" K DA D ^DIR K DIR
. S:'Y ACDQ=2
. Q
Q:ACDQ
Q
;
CHKCS ; EP - CHECK CLIENT SERVICE
; ADD MODE
; should be initial or reopen with no t/d/c
S ACDX="A",ACDLI="",ACDLT=""
F S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX),-1) Q:ACDX="" D Q:ACDQ
. Q:$E(ACDX,1,5)>$E(ACDVDTI,1,5) ; ignore later months
. S ACDY="A"
. F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY),-1) Q:'ACDY D I ACDLI]"",ACDLT]"" S ACDQ=1 Q
.. S X=^ACDVIS(ACDY,0)
.. I $P(X,U,2)=ACDCOMC,$P(X,U,7)=ACDCOMT D Q
... I $P(X,U,4)="TD" S ACDLT=ACDX Q
... I $P(X,U,4)="IN"!($P(X,U,4)="RE") S ACDLI=ACDX Q
... Q
.. Q
. Q
S ACDQ=0
I ACDLT>ACDLI,$E(ACDLT,1,5)<$E(ACDVDTI,1,5) W !,IORVON,"There is a TRANS/DISC/CLOSE CDMIS VISIT for component",!,ACDCOMCL,"/",ACDCOMTL," before ",ACDVDTE,".",IORVOFF,! D DSPVSIT^ACDDEU(ACDY),PAUSE^ACDDEU S ACDQ=1 Q
;I ACDLT>ACDLI W !,IORVON,"Not an open component.",IORVOFF S DIR(0)="Y",DIR("A")="Are you sure you want to add CS to this component",DIR("B")="Y" K DA D ^DIR K DIR I 'Y S ACDQ=1 Q
Q
ACDDE3A ;IHS/ADC/EDE/KML - DATA ENTRY/CHECK CONTACT TYPES;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
CHKRE ; EP - CHECK REOPEN
+1 ; ADD MODE
+2 ; should have been a t/d/c, may have followups
+3 SET ACDX="A"
SET ACDQ=0
+4 FOR
SET ACDX=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX),-1)
IF ACDX=""
QUIT
Begin DoDot:1
+5 ; ignore later dates
IF ACDX>ACDVDTI
QUIT
+6 SET ACDY="A"
+7 FOR
SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY),-1)
IF 'ACDY
QUIT
Begin DoDot:2
+8 SET X=^ACDVIS(ACDY,0)
+9 IF $PIECE(X,U,2)=ACDCOMC
IF $PIECE(X,U,7)=ACDCOMT
IF $PIECE(X,U,4)="TD"
SET ACDQ=1
QUIT
+10 QUIT
End DoDot:2
IF ACDQ
QUIT
+11 IF ACDQ
QUIT
+12 SET ACDY="A"
+13 FOR
SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY),-1)
IF 'ACDY
QUIT
Begin DoDot:2
+14 SET X=^ACDVIS(ACDY,0)
+15 IF $PIECE(X,U,2)=ACDCOMC
IF $PIECE(X,U,7)=ACDCOMT
IF $PIECE(X,U,4)'="FU"
SET ACDQ=1
QUIT
+16 QUIT
End DoDot:2
IF ACDQ
QUIT
+17 QUIT
End DoDot:1
IF ACDQ
QUIT
+18 SET ACDQ=0
+19 IF ACDY
IF $PIECE(X,U,4)'="TD"
WRITE !,IORVON,"Last non-followup CDMIS VISIT for component ",ACDCOMCL,"/",ACDCOMTL,!,"on or prior to ",ACDVDTE," was not a TRANS/DISC/CLOSE.",IORVOFF,!
DO DSPVSIT^ACDDEU(ACDY)
Begin DoDot:1
+20 SET DIR(0)="Y"
SET DIR("A")="Do you want to add this CDMIS VISIT anyway"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+21 IF 'Y
SET ACDQ=1
+22 QUIT
End DoDot:1
QUIT
+23 SET ACDFLG=0
+24 IF ACDY
SET ACDX=ACDX-1
FOR
SET ACDX=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX))
IF ACDX=""
QUIT
Begin DoDot:1
+25 SET ACDY=+ACDY
FOR
SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY))
IF 'ACDY
QUIT
Begin DoDot:2
+26 SET X=^ACDVIS(ACDY,0)
+27 IF $PIECE(X,U,2)=ACDCOMC
IF $PIECE(X,U,7)=ACDCOMT
Begin DoDot:3
+28 IF $PIECE(X,U,4)="TD"
SET ACDFLG=1
SET ACDQ=1
QUIT
+29 IF $PIECE(X,U,4)="RE"
SET ACDFLG=2
SET ACDQ=1
QUIT
+30 QUIT
End DoDot:3
QUIT
+31 QUIT
End DoDot:2
IF ACDQ
QUIT
+32 QUIT
End DoDot:1
IF ACDQ
QUIT
+33 SET ACDQ=0
+34 IF ACDFLG
WRITE !,IORVON,"Subsequent ",$SELECT(ACDFLG=1:"TRANS/DISC/CLOSE",1:"REOPEN")," CDMIS VISIT for component ",ACDCOMCL,"/",ACDCOMTL,!,"after ",ACDVDTE,".",IORVOFF,!
Begin DoDot:1
+35 DO DSPHIST^ACDDEU
+36 SET DIR(0)="Y"
SET DIR("A")="Do you want to add this CDMIS VISIT anyway"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+37 IF 'Y
SET ACDQ=2
+38 QUIT
End DoDot:1
+39 IF ACDQ
QUIT
+40 QUIT
+41 ;
CHKFU ; EP - CHECK FOLLOWUP
+1 ; ADD MODE
+2 ; should have been a t/d/c, may have followups
+3 SET ACDX=""
+4 FOR
SET ACDX=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX),-1)
IF ACDX=""
QUIT
Begin DoDot:1
+5 ; ignore later dates
IF ACDX>ACDVDTI
QUIT
+6 SET ACDY="A"
+7 FOR
SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY),-1)
IF 'ACDY
QUIT
Begin DoDot:2
+8 SET X=^ACDVIS(ACDY,0)
+9 IF $PIECE(X,U,2)=ACDCOMC
IF $PIECE(X,U,7)=ACDCOMT
IF $PIECE(X,U,4)'="FU"
SET ACDQ=1
QUIT
+10 QUIT
End DoDot:2
IF ACDQ
QUIT
+11 QUIT
End DoDot:1
IF ACDQ
QUIT
+12 SET ACDQ=0
+13 IF ACDY
IF $PIECE(X,U,4)'="TD"
WRITE !,IORVON,"Last non-followup CDMIS VISIT for component ",ACDCOMCL,"/",ACDCOMTL,!,"was not a TRANS/DISC/CLOSE.",IORVOFF,!
DO DSPVSIT^ACDDEU(ACDY)
Begin DoDot:1
+14 SET DIR(0)="Y"
SET DIR("A")="Do you want to add this CDMIS VISIT anyway"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+15 IF 'Y
SET ACDQ=1
+16 QUIT
End DoDot:1
QUIT
+17 QUIT
+18 ;
CHKTD ; EP - CHECK TRANS/DISC/CLOSE
+1 ; ADD MODE
+2 ; should be initial or reopen with no t/d/c
+3 SET ACDX="A"
+4 FOR
SET ACDX=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX),-1)
IF ACDX=""
QUIT
Begin DoDot:1
+5 ; ignore later dates
IF ACDX>ACDVDTI
QUIT
+6 SET ACDY="A"
+7 FOR
SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY),-1)
IF 'ACDY
QUIT
Begin DoDot:2
+8 SET X=^ACDVIS(ACDY,0)
+9 IF $PIECE(X,U,2)=ACDCOMC
IF $PIECE(X,U,7)=ACDCOMT
IF ($PIECE(X,U,4)="TD"!($PIECE(X,U,4)="IN")!($PIECE(X,U,4)="RE"))
SET ACDQ=1
QUIT
+10 QUIT
End DoDot:2
IF ACDQ
QUIT
+11 QUIT
End DoDot:1
IF ACDQ
QUIT
+12 SET ACDQ=0
+13 ; should have been caught by CHKFIN
IF 'ACDY
WRITE !,IORVON,"Impossible error in ADDTD^ACDDE. Notify programmer.",IORVOFF,!!
SET ACDQ=1
IF $DATA(^%ZOSF("$ZE"))
SET X="CDMIS VISIT"
SET @^("$ZE")
DO @^%ZOSF("ERRTN")
DO PAUSE^ACDDEU
QUIT
+14 IF $PIECE(X,U,4)="TD"
WRITE !,IORVON,"There is already a TRANS/DISC/CLOSE CDMIS VISIT for component",!,ACDCOMCL,"/",ACDCOMTL," on or before ",ACDVDTE,".",IORVOFF,!
DO DSPVSIT^ACDDEU(ACDY)
DO PAUSE^ACDDEU
SET ACDQ=1
QUIT
+15 IF ACDY
SET ACDX=ACDX-1
FOR
SET ACDX=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX))
IF ACDX=""
QUIT
Begin DoDot:1
+16 SET ACDY=+ACDY
FOR
SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY))
IF 'ACDY
QUIT
Begin DoDot:2
+17 SET X=^ACDVIS(ACDY,0)
+18 IF $PIECE(X,U,2)=ACDCOMC
IF $PIECE(X,U,7)=ACDCOMT
Begin DoDot:3
+19 IF $PIECE(X,U,4)="TD"
SET ACDQ=1
QUIT
+20 IF $PIECE(X,U,4)="RE"
SET ACDY=0
SET ACDQ=1
QUIT
+21 QUIT
End DoDot:3
QUIT
+22 QUIT
End DoDot:2
IF ACDQ
QUIT
+23 QUIT
End DoDot:1
IF ACDQ
QUIT
+24 SET ACDQ=0
+25 IF ACDY
WRITE !,IORVON,"Subsequent TRANS/DISC/CLOSE CDMIS VISIT for component ",ACDCOMCL,"/",ACDCOMTL,!,"after ",ACDVDTE,".",IORVOFF,!
Begin DoDot:1
+26 DO DSPHIST^ACDDEU
+27 SET DIR(0)="Y"
SET DIR("A")="Do you want to add this CDMIS VISIT anyway"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+28 IF 'Y
SET ACDQ=2
+29 QUIT
End DoDot:1
+30 IF ACDQ
QUIT
+31 QUIT
+32 ;
CHKCS ; EP - CHECK CLIENT SERVICE
+1 ; ADD MODE
+2 ; should be initial or reopen with no t/d/c
+3 SET ACDX="A"
SET ACDLI=""
SET ACDLT=""
+4 FOR
SET ACDX=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX),-1)
IF ACDX=""
QUIT
Begin DoDot:1
+5 ; ignore later months
IF $EXTRACT(ACDX,1,5)>$EXTRACT(ACDVDTI,1,5)
QUIT
+6 SET ACDY="A"
+7 FOR
SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY),-1)
IF 'ACDY
QUIT
Begin DoDot:2
+8 SET X=^ACDVIS(ACDY,0)
+9 IF $PIECE(X,U,2)=ACDCOMC
IF $PIECE(X,U,7)=ACDCOMT
Begin DoDot:3
+10 IF $PIECE(X,U,4)="TD"
SET ACDLT=ACDX
QUIT
+11 IF $PIECE(X,U,4)="IN"!($PIECE(X,U,4)="RE")
SET ACDLI=ACDX
QUIT
+12 QUIT
End DoDot:3
QUIT
+13 QUIT
End DoDot:2
IF ACDLI]""
IF ACDLT]""
SET ACDQ=1
QUIT
+14 QUIT
End DoDot:1
IF ACDQ
QUIT
+15 SET ACDQ=0
+16 IF ACDLT>ACDLI
IF $EXTRACT(ACDLT,1,5)<$EXTRACT(ACDVDTI,1,5)
WRITE !,IORVON,"There is a TRANS/DISC/CLOSE CDMIS VISIT for component",!,ACDCOMCL,"/",ACDCOMTL," before ",ACDVDTE,".",IORVOFF,!
DO DSPVSIT^ACDDEU(ACDY)
DO PAUSE^ACDDEU
SET ACDQ=1
QUIT
+17 ;I ACDLT>ACDLI W !,IORVON,"Not an open component.",IORVOFF S DIR(0)="Y",DIR("A")="Are you sure you want to add CS to this component",DIR("B")="Y" K DA D ^DIR K DIR I 'Y S ACDQ=1 Q
+18 QUIT
