ACDPCS1M ;IHS/ADC/EDE/KML - DISPLAY PATIENT CS BY PROVIDER FOR 1 MONTH;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
; This routine displays a patient's CDMIS client services by provider for one month.
;
START ;
F D PATLOOP Q:ACDQ
D EOJ
Q
;
PATLOOP ; DISPLAY PATIENTS UNTIL DONE
D GETPAT
Q:ACDQ
S ACDTCTG="CS"
D GETVSITS^ACDDEU
K ACDTCTG
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^ACDCSH1M",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
S ACDQ=0
D DEV^ACDDEU Q:ACDQ
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
I $D(ZTQUEUED) D EOJ S ZTREQ="@"
U 0
Q
;
DISPLAY2 ; DISPLAY VISIT FOR SELECTED MONTH
I $E(IOST,1,2)="C-" W @IOF
D CONF^ACDDEU W !
W "CDMIS CLIENT SERVICE history for client ",ACDDFN,!!
W "----------",!
S ACDX=ACDSTART,ACDQ=0
F S ACDX=$O(^TMP("ACD",$J,"VISITS",ACDX)) Q:$E(ACDX,1,5)'=ACDMONTH D Q:ACDQ
. S ACDY=0
. F S ACDY=$O(^TMP("ACD",$J,"VISITS",ACDX,ACDY)) Q:'ACDY D Q:ACDQ
.. Q:$P(^ACDVIS(ACDY,0),U,4)'="CS"
.. S ACDVIEN=ACDY
.. D DSPV^ACDDEU
.. D DSPCSH
.. Q
. Q
W "----------",!
Q
;
DSPCSH ; DISPLAY CDMIS CLIENT SERVICE HISTORY FOR ONE CS VISIT
K ^TMP("ACD",$J,"CS")
S YY=0
F S YY=$O(^ACDCS("C",ACDVIEN,YY)) Q:'YY S X=^ACDCS(YY,0) D
. S Z=0
. F S Z=$O(^ACDCS(YY,1,Z)) Q:'Z D
.. S ACDPRV=$P(^ACDCS(YY,1,Z,0),U)
.. S ^TMP("ACD",$J,"CS",ACDPRV,$P(X,U),YY)=$P(X,U,2)
.. Q
. Q
S ACDPRV=0
F S ACDPRV=$O(^TMP("ACD",$J,"CS",ACDPRV)) Q:'ACDPRV D Q:ACDQ
.; D PFTV^XBPFTV(6,ACDPRV,.X)
. S X=$P(^VA(200,ACDPRV,0),U)
. W ?5,X,!
. S YY=0
. F S YY=$O(^TMP("ACD",$J,"CS",ACDPRV,YY)) Q:'YY S Z=0 F S Z=$O(^TMP("ACD",$J,"CS",ACDPRV,YY,Z)) Q:'Z D Q:ACDQ
.. S X=^TMP("ACD",$J,"CS",ACDPRV,YY,Z)
.. D PFTV^XBPFTV(9002170.6,X,.W)
.. D F Q:ACDQ
.. W ?15,YY,?19,W,?55,$J(+$P(^ACDCS(Z,0),U,4),5,2)_" h",!
.. Q
. Q
K ^TMP("ACD",$J,"CS")
Q
;
F ;Form feed
I $Y+4>IOSL D
. I '$D(ZTQUEUED),'$D(ACDSLAVE),$E(IOST,1,2)'="P-" D PAUSE^ACDDEU S:$D(DIRUT) ACDQ=1
. W @IOF
. Q
Q
;
GETVSITS ; EP - GET CDMIS VISITS FOR THIS CLIENT
;
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
K ^TMP("ACD",$J)
D ^ACDKILL
Q
ACDPCS1M ;IHS/ADC/EDE/KML - DISPLAY PATIENT CS BY PROVIDER FOR 1 MONTH;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
+3 ; This routine displays a patient's CDMIS client services by provider 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 SET ACDTCTG="CS"
+4 DO GETVSITS^ACDDEU
+5 KILL ACDTCTG
+6 IF ACDQ
QUIT
+7 IF '$DATA(^TMP("ACD",$JOB,"VISITS"))
WRITE !!,"No CDMIS VISIT history for patient ",ACDDFN,!
QUIT
+8 ; display visit history
DO DSPHIST
+9 DO GETMONTH
+10 IF ACDQ
QUIT
+11 SET ACDSTART=$$FMADD^XLFDT(ACDMONTH_"01",-1)
+12 SET X=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDSTART))
+13 IF $EXTRACT(X,1,5)'=ACDMONTH
WRITE !!,"No CDMIS VISITs during selected month for patient ",ACDDFN,!
QUIT
+14 IF $DATA(IO("Q"))
Begin DoDot:1
+15 SET ZTRTN="DISPLAY^ACDCSH1M"
SET ZTDESC="CDMIS VISITS ONE MONTH"
SET ZTDTH=$HOROLOG
SET ZTSAVE("ACD*")=""
SET ZTSAVE("^TMP(""ACD"",$J,""VISITS"",")=""
+16 DO ^%ZTLOAD
+17 QUIT
End DoDot:1
QUIT
+18 DO DISPLAY
+19 IF '$DATA(ACDSLAVE)
IF $EXTRACT(IOST,1,2)'="P-"
DO PAUSE^ACDDEU
+20 SET ACDQ=0
+21 DO DEV^ACDDEU
IF ACDQ
QUIT
+22 IF $DATA(ACDSLAVE)!(IO'=IO(0))
DO DISPLAY
+23 KILL ACDSLAVE
SET IO=IO(0)
+24 QUIT
+25 ;
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 IF $DATA(ZTQUEUED)
DO EOJ
SET ZTREQ="@"
+7 USE 0
+8 QUIT
+9 ;
DISPLAY2 ; DISPLAY VISIT FOR SELECTED MONTH
+1 IF $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+2 DO CONF^ACDDEU
WRITE !
+3 WRITE "CDMIS CLIENT SERVICE history for client ",ACDDFN,!!
+4 WRITE "----------",!
+5 SET ACDX=ACDSTART
SET ACDQ=0
+6 FOR
SET ACDX=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX))
IF $EXTRACT(ACDX,1,5)'=ACDMONTH
QUIT
Begin DoDot:1
+7 SET ACDY=0
+8 FOR
SET ACDY=$ORDER(^TMP("ACD",$JOB,"VISITS",ACDX,ACDY))
IF 'ACDY
QUIT
Begin DoDot:2
+9 IF $PIECE(^ACDVIS(ACDY,0),U,4)'="CS"
QUIT
+10 SET ACDVIEN=ACDY
+11 DO DSPV^ACDDEU
+12 DO DSPCSH
+13 QUIT
End DoDot:2
IF ACDQ
QUIT
+14 QUIT
End DoDot:1
IF ACDQ
QUIT
+15 WRITE "----------",!
+16 QUIT
+17 ;
DSPCSH ; DISPLAY CDMIS CLIENT SERVICE HISTORY FOR ONE CS VISIT
+1 KILL ^TMP("ACD",$JOB,"CS")
+2 SET YY=0
+3 FOR
SET YY=$ORDER(^ACDCS("C",ACDVIEN,YY))
IF 'YY
QUIT
SET X=^ACDCS(YY,0)
Begin DoDot:1
+4 SET Z=0
+5 FOR
SET Z=$ORDER(^ACDCS(YY,1,Z))
IF 'Z
QUIT
Begin DoDot:2
+6 SET ACDPRV=$PIECE(^ACDCS(YY,1,Z,0),U)
+7 SET ^TMP("ACD",$JOB,"CS",ACDPRV,$PIECE(X,U),YY)=$PIECE(X,U,2)
+8 QUIT
End DoDot:2
+9 QUIT
End DoDot:1
+10 SET ACDPRV=0
+11 FOR
SET ACDPRV=$ORDER(^TMP("ACD",$JOB,"CS",ACDPRV))
IF 'ACDPRV
QUIT
Begin DoDot:1
+12 ; D PFTV^XBPFTV(6,ACDPRV,.X)
+13 SET X=$PIECE(^VA(200,ACDPRV,0),U)
+14 WRITE ?5,X,!
+15 SET YY=0
+16 FOR
SET YY=$ORDER(^TMP("ACD",$JOB,"CS",ACDPRV,YY))
IF 'YY
QUIT
SET Z=0
FOR
SET Z=$ORDER(^TMP("ACD",$JOB,"CS",ACDPRV,YY,Z))
IF 'Z
QUIT
Begin DoDot:2
+17 SET X=^TMP("ACD",$JOB,"CS",ACDPRV,YY,Z)
+18 DO PFTV^XBPFTV(9002170.6,X,.W)
+19 DO F
IF ACDQ
QUIT
+20 WRITE ?15,YY,?19,W,?55,$JUSTIFY(+$PIECE(^ACDCS(Z,0),U,4),5,2)_" h",!
+21 QUIT
End DoDot:2
IF ACDQ
QUIT
+22 QUIT
End DoDot:1
IF ACDQ
QUIT
+23 KILL ^TMP("ACD",$JOB,"CS")
+24 QUIT
+25 ;
F ;Form feed
+1 IF $Y+4>IOSL
Begin DoDot:1
+2 IF '$DATA(ZTQUEUED)
IF '$DATA(ACDSLAVE)
IF $EXTRACT(IOST,1,2)'="P-"
DO PAUSE^ACDDEU
IF $DATA(DIRUT)
SET ACDQ=1
+3 WRITE @IOF
+4 QUIT
End DoDot:1
+5 QUIT
+6 ;
GETVSITS ; EP - GET CDMIS VISITS FOR THIS CLIENT
+1 ;
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 KILL ^TMP("ACD",$JOB)
+3 DO ^ACDKILL
+4 QUIT
