ACDLVBD ;IHS/ADC/EDE/KML - LIST VISITS FOR DATE;
;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
;
; This routine lists visits for one date
;
START ;
W !
F D DATELOOP Q:ACDQ
D EOJ
Q
;
DATELOOP ; LIST VISITS BY DATE UNTIL DONE
D GETDATE
Q:ACDQ
D LSTVSITS
D DEV^ACDDEU Q:ACDQ
I $D(ACDSLAVE)!(IO'=IO(0)) D LSTVSITS
K ACDSLAVE S IO=IO(0)
U 0
Q
;
GETDATE ; GET DATE
S ACDQ=1
S DIR(0)="9002172.1,.01",DIR("A")="VISIT DATE" K DA D ^DIR K DIR
Q:$D(DIRUT)
S ACDVDTI=Y,ACDVDTE=Y(0)
S ACDQ=0
Q
;
;
LSTVSITS ; LIST VISITS FOR ONE DATE
I $D(IO("Q")) D Q
. S ZTRTN="LSTVSITQ^ACDLVBD",ZTDESC="CDMIS VISIT LIST FOR DATE",ZTDTH=$H,ZTSAVE("ACD*")=""
. D ^%ZTLOAD
. Q
D LSTVSITQ
S ACDQ=0
Q
;
LSTVSITQ ; EP - FOR TASKMAN
I $D(ACDSLAVE) S IOP=ACDSLAVE D ^%ZIS
U IO
W:IO'=IO(0) @IOF
D:$E(IOST,1,2)="P-" CONF^ACDDEU
W !
I '$D(^ACDVIS("B",ACDVDTI)) W !,"----------",!,"No CDMIS visits for ",ACDVDTE,!,"----------",! Q
S ACDY=0,ACDLC=0
F S ACDY=$O(^ACDVIS("B",ACDVDTI,ACDY)) Q:'ACDY S X=^ACDVIS(ACDY,0) I $P($G(^("BWP")),U)=ACDPGM D Q:ACDQ
. S ACDQ=0
. S ACDLC=ACDLC+1
. S DIC="9002172.1",DA=ACDY,DR=".01;1;3;4;5",DIQ="ACDPDD(",DIQ(0)="EI"
. D DIQ1^ACDFMC
. S X=ACDPDD(9002172.1,ACDY,.01,"I") W $E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),?9," - ",ACDPDD(9002172.1,ACDY,4,"E")," - ",ACDPDD(9002172.1,ACDY,1,"E"),"/",ACDPDD(9002172.1,ACDY,5,"E")," ",ACDPDD(9002172.1,ACDY,3,"E"),!
. K ACDPDD
. I '(ACDLC#20) D PAUSE^ACDDEU S:$D(DIRUT) ACDQ=1
. Q
D:$E(IOST,1,2)'="P-" PAUSE^ACDDEU
I $D(ACDSLAVE) W @IOF D ^%ZISC
U 0
I $D(ZTQUEUED) D EOJ S ZTREQ="@"
Q
;
EOJ ;
D ^%ZISC
D ^ACDKILL
Q
ACDLVBD ;IHS/ADC/EDE/KML - LIST VISITS FOR DATE;
+1 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998
+2 ;
+3 ; This routine lists visits for one date
+4 ;
START ;
+1 WRITE !
+2 FOR
DO DATELOOP
IF ACDQ
QUIT
+3 DO EOJ
+4 QUIT
+5 ;
DATELOOP ; LIST VISITS BY DATE UNTIL DONE
+1 DO GETDATE
+2 IF ACDQ
QUIT
+3 DO LSTVSITS
+4 DO DEV^ACDDEU
IF ACDQ
QUIT
+5 IF $DATA(ACDSLAVE)!(IO'=IO(0))
DO LSTVSITS
+6 KILL ACDSLAVE
SET IO=IO(0)
+7 USE 0
+8 QUIT
+9 ;
GETDATE ; GET DATE
+1 SET ACDQ=1
+2 SET DIR(0)="9002172.1,.01"
SET DIR("A")="VISIT DATE"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
QUIT
+4 SET ACDVDTI=Y
SET ACDVDTE=Y(0)
+5 SET ACDQ=0
+6 QUIT
+7 ;
+8 ;
LSTVSITS ; LIST VISITS FOR ONE DATE
+1 IF $DATA(IO("Q"))
Begin DoDot:1
+2 SET ZTRTN="LSTVSITQ^ACDLVBD"
SET ZTDESC="CDMIS VISIT LIST FOR DATE"
SET ZTDTH=$HOROLOG
SET ZTSAVE("ACD*")=""
+3 DO ^%ZTLOAD
+4 QUIT
End DoDot:1
QUIT
+5 DO LSTVSITQ
+6 SET ACDQ=0
+7 QUIT
+8 ;
LSTVSITQ ; EP - FOR TASKMAN
+1 IF $DATA(ACDSLAVE)
SET IOP=ACDSLAVE
DO ^%ZIS
+2 USE IO
+3 IF IO'=IO(0)
WRITE @IOF
+4 IF $EXTRACT(IOST,1,2)="P-"
DO CONF^ACDDEU
+5 WRITE !
+6 IF '$DATA(^ACDVIS("B",ACDVDTI))
WRITE !,"----------",!,"No CDMIS visits for ",ACDVDTE,!,"----------",!
QUIT
+7 SET ACDY=0
SET ACDLC=0
+8 FOR
SET ACDY=$ORDER(^ACDVIS("B",ACDVDTI,ACDY))
IF 'ACDY
QUIT
SET X=^ACDVIS(ACDY,0)
IF $PIECE($GET(^("BWP")),U)=ACDPGM
Begin DoDot:1
+9 SET ACDQ=0
+10 SET ACDLC=ACDLC+1
+11 SET DIC="9002172.1"
SET DA=ACDY
SET DR=".01;1;3;4;5"
SET DIQ="ACDPDD("
SET DIQ(0)="EI"
+12 DO DIQ1^ACDFMC
+13 SET X=ACDPDD(9002172.1,ACDY,.01,"I")
WRITE $EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3),?9," - ",ACDPDD(9002172.1,ACDY,4,"E")," - ",ACDPDD(9002172.1,ACDY,1,"E"),"/",ACDPDD(9002172.1,ACDY,5,"E")," ",ACDPDD(9002172.1,ACDY,3,"E"),!
+14 KILL ACDPDD
+15 IF '(ACDLC#20)
DO PAUSE^ACDDEU
IF $DATA(DIRUT)
SET ACDQ=1
+16 QUIT
End DoDot:1
IF ACDQ
QUIT
+17 IF $EXTRACT(IOST,1,2)'="P-"
DO PAUSE^ACDDEU
+18 IF $DATA(ACDSLAVE)
WRITE @IOF
DO ^%ZISC
+19 USE 0
+20 IF $DATA(ZTQUEUED)
DO EOJ
SET ZTREQ="@"
+21 QUIT
+22 ;
EOJ ;
+1 DO ^%ZISC
+2 DO ^ACDKILL
+3 QUIT
