ACDPVH1M ;IHS/ADC/EDE/KML - DISPLAY PATIENT VISITS FOR 1 MO;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
; This routine displays a patient's CDMIS visits for one month.
;
START ;
F D PATLOOP Q:ACDQ
D EOJ
Q
;
PATLOOP ; DISPLAY PATIENTS UNTIL DONE
D GETPAT
Q:ACDQ
D GETVSITS^ACDDEU
Q:ACDQ
I '$D(^TMP("ACD",$J,"VISITS")) W !!,"No CDMIS VISIT history for patient ",ACDDFN,! Q
D DSPHIST ; display visit history
D GETMONTH
Q:ACDQ
S ACDSTART=$$FMADD^XLFDT(ACDMONTH_"01",-1)
S X=$O(^TMP("ACD",$J,"VISITS",ACDSTART))
I $E(X,1,5)'=ACDMONTH W !!,"No CDMIS VISITs during selected month for patient ",ACDDFN,! Q
I $D(IO("Q")) D Q
. S ZTRTN="DISPLAY^ACDPVH1M",ZTDESC="CDMIS VISITS ONE MONTH",ZTDTH=$H,ZTSAVE("ACD*")="",ZTSAVE("^TMP(""ACD"",$J,""VISITS"",")=""
. D ^%ZTLOAD
. Q
D DISPLAY
I '$D(ACDSLAVE),$E(IOST,1,2)'="P-" D PAUSE^ACDDEU
D DEV^ACDDEU Q:ACDQ ; select device
I $D(ACDSLAVE)!(IO'=IO(0)) D DISPLAY
K ACDSLAVE S IO=IO(0)
Q
;
DSPHIST ; DISPLAY VISIT HISTORY TO HELP USER SELECT
NEW IOST
S IOST="C-VT100"
D DSPHIST^ACDDEU ; display visit history
Q
;
DISPLAY ; EP - FOR TASKMAN
I $D(ACDSLAVE) S IOP=ACDSLAVE D ^%ZIS
U IO
D DISPLAY2
I $E(IOST,1,2)="P-" W @IOF
I $D(ACDSLAVE) D ^%ZISC
U 0
I $D(ZTQUEUED) D EOJ S ZTREQ="@"
Q
;
DISPLAY2 ; DISPLAY VISIT FOR SELECTED MONTH
D CONF^ACDDEU W !
W "CDMIS VISIT history for client ",ACDDFN,!!
W "----------",!
S ACDX=ACDSTART
F S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX)) Q:$E(ACDX,1,5)'=ACDMONTH S ACDY=0 F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY)) Q:'ACDY D DSPV^ACDDEU I $P(^ACDVIS(ACDY,0),U,4)="CS" S ACDVIEN=ACDY D DSPCSH^ACDDEU
W "----------",!
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
;
GETMONTH ; GET MONTH
S ACDQ=1
S DIR(0)="DO^::E",DIR("A")="Enter month/year" K DA D ^DIR K DIR
Q:$D(DIRUT)
Q:Y=""
S ACDMONTH=$E(Y,1,5)
S ACDQ=0
Q
;
EOJ ;
D ^%ZISC
D ^ACDKILL
Q
ACDPVH1M ;IHS/ADC/EDE/KML - DISPLAY PATIENT VISITS FOR 1 MO;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
+3 ; This routine displays a patient's CDMIS visits for one month.
+4 ;
START ;
+1 FOR
DO PATLOOP
IF ACDQ
QUIT
+2 DO EOJ
+3 QUIT
+4 ;
PATLOOP ; DISPLAY PATIENTS UNTIL DONE
+1 DO GETPAT
+2 IF ACDQ
QUIT
+3 DO GETVSITS^ACDDEU
+4 IF ACDQ
QUIT
+5 IF '$DATA(^TMP("ACD",$JOB,"VISITS"))
WRITE !!,"No CDMIS VISIT history for patient ",ACDDFN,!
QUIT
+6 ; display visit history
DO DSPHIST
+7 DO GETMONTH
+8 IF ACDQ
QUIT
+9 SET ACDSTART=$$FMADD^XLFDT(ACDMONTH_"01",-1)
+10 SET X=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDSTART))
+11 IF $EXTRACT(X,1,5)'=ACDMONTH
WRITE !!,"No CDMIS VISITs during selected month for patient ",ACDDFN,!
QUIT
+12 IF $DATA(IO("Q"))
Begin DoDot:1
+13 SET ZTRTN="DISPLAY^ACDPVH1M"
SET ZTDESC="CDMIS VISITS ONE MONTH"
SET ZTDTH=$HOROLOG
SET ZTSAVE("ACD*")=""
SET ZTSAVE("^TMP(""ACD"",$J,""VISITS"",")=""
+14 DO ^%ZTLOAD
+15 QUIT
End DoDot:1
QUIT
+16 DO DISPLAY
+17 IF '$DATA(ACDSLAVE)
IF $EXTRACT(IOST,1,2)'="P-"
DO PAUSE^ACDDEU
+18 ; select device
DO DEV^ACDDEU
IF ACDQ
QUIT
+19 IF $DATA(ACDSLAVE)!(IO'=IO(0))
DO DISPLAY
+20 KILL ACDSLAVE
SET IO=IO(0)
+21 QUIT
+22 ;
DSPHIST ; DISPLAY VISIT HISTORY TO HELP USER SELECT
+1 NEW IOST
+2 SET IOST="C-VT100"
+3 ; display visit history
DO DSPHIST^ACDDEU
+4 QUIT
+5 ;
DISPLAY ; EP - FOR TASKMAN
+1 IF $DATA(ACDSLAVE)
SET IOP=ACDSLAVE
DO ^%ZIS
+2 USE IO
+3 DO DISPLAY2
+4 IF $EXTRACT(IOST,1,2)="P-"
WRITE @IOF
+5 IF $DATA(ACDSLAVE)
DO ^%ZISC
+6 USE 0
+7 IF $DATA(ZTQUEUED)
DO EOJ
SET ZTREQ="@"
+8 QUIT
+9 ;
DISPLAY2 ; DISPLAY VISIT FOR SELECTED MONTH
+1 DO CONF^ACDDEU
WRITE !
+2 WRITE "CDMIS VISIT history for client ",ACDDFN,!!
+3 WRITE "----------",!
+4 SET ACDX=ACDSTART
+5 FOR
SET ACDX=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX))
IF $EXTRACT(ACDX,1,5)'=ACDMONTH
QUIT
SET ACDY=0
FOR
SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY))
IF 'ACDY
QUIT
DO DSPV^ACDDEU
IF $PIECE(^ACDVIS(ACDY,0),U,4)="CS"
SET ACDVIEN=ACDY
DO DSPCSH^ACDDEU
+6 WRITE "----------",!
+7 QUIT
+8 ;
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 ;
GETMONTH ; GET MONTH
+1 SET ACDQ=1
+2 SET DIR(0)="DO^::E"
SET DIR("A")="Enter month/year"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 IF Y=""
QUIT
+5 SET ACDMONTH=$EXTRACT(Y,1,5)
+6 SET ACDQ=0
+7 QUIT
+8 ;
EOJ ;
+1 DO ^%ZISC
+2 DO ^ACDKILL
+3 QUIT
