- 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
