- ASDCWMA ; IHS/ADC/PDW/ENM - CLERK WHO MADE APPT LIST ; [ 03/25/1999 11:48 AM ]
- ;;5.0;IHS SCHEDULING;;MAR 25, 1999
- ;
- A ; -- driver
- D CL I Y=-1 D Q Q
- D BD I Y=-1 D Q Q
- D ED I Y=-1 D Q Q
- D ZIS I POP D Q Q
- I $D(IO("Q")) D QUE,Q Q
- D START Q
- ;
- CL ; -- select clinic
- D ASK2^SDDIV Q:Y<0 S VAUTNI=1 D CLINIC^VAUTOMA Q
- ;
- BD ; -- beginning date
- S %DT="AEQ",%DT("A")="Select beginning date: ",X="" D ^%DT S SDBD=Y Q
- ;
- ED ; -- ending date
- S %DT="AEQ",%DT("A")="Select ending date: ",X="" D ^%DT S SDED=Y Q
- ;
- ZIS ; -- select device
- S %ZIS="PQ" D ^%ZIS Q
- ;
- QUE ; -- queued
- K IO("Q") S ZTRTN="START^ASDCWMA",ZTDESC="CLERK WHO MADE APPT LIST"
- S ZTSAVE("SDBD")="",ZTSAVE("SDED")="",ZTSAVE("VAUT*")="",ZTSAVE("DIV")=""
- D ^%ZTLOAD D HOME^%ZIS K ZTSK Q
- ;
- Q K X,Y,SDBD,SDED,VAUTC,VAUTD,POP,SDQUIT,N,P,D,SC,SD,ASDQT
- D ^%ZISC Q
- ;
- START ;EP
- S ASDQT=0 U IO
- I VAUTC D ALL Q
- S SD=""
- F S SD=$O(VAUTC(SD)) Q:SD="" S SC=VAUTC(SD) Q:'SC D 1 Q:ASDQT
- D Q Q
- ;
- ALL ; -- all clinics
- S SC=0 F S SC=$O(^SC(SC)) Q:'SC D Q:ASDQT
- . I $O(VAUTD(0)) Q:'$D(VAUTD(+$P(^SC(SC,0),U,15)))
- . Q:'$$ACTV^ASDUT(SC) D 1
- Q
- ;
- 1 ; -- loop clinics
- D HD(0)
- S D=SDBD-.001
- F S D=$O(^SC(+SC,"S",D)) Q:'D Q:D>(SDED+.9) D Q:ASDQT
- . S P=0 F S P=$O(^SC(+SC,"S",D,1,P)) Q:'P D Q:ASDQT
- .. S N=^SC(+SC,"S",D,1,P,0) I $Y>(IOSL-7) D HD(1) Q:ASDQT
- .. W !,$$D(D),?20,$$HRC^ASDUT(+N),?30,$$AGE(+N)
- .. W ?40,$$CLK($P(N,U,6)),?65,$$D($P(N,U,7))
- I IOST["C-",'ASDQT S DIR(0)="E" D ^DIR S:'Y ASDQT=1
- Q
- ;
- HD(X) ; -- heading
- I IOST["C-",X S DIR(0)="E" D ^DIR S:'Y ASDQT=1 Q:'Y
- W @IOF,!!,?35,$P(^SC(+SC,0),U),!!,"DATE/TIME",?20,"HRCN"
- W ?30,"AGE",?40,"CLERK WHO MADE APPT",?65,"DATE APPT MADE",!!
- Q
- ;
- D(Y) ; -- date
- NEW N,P,D
- X ^DD("DD") Q Y
- ;
- AGE(X) ; -- age
- NEW N,D,P
- Q $$VAL^XBDIQ1(9000001,X,1102.98)
- ;
- CLK(X) ; -- clerk who made appt
- NEW N,D,P
- Q $E($P(^VA(200,X,0),U),1,20)
- ASDCWMA ; IHS/ADC/PDW/ENM - CLERK WHO MADE APPT LIST ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;IHS SCHEDULING;;MAR 25, 1999
- +2 ;
- A ; -- driver
- +1 DO CL
- IF Y=-1
- DO Q
- QUIT
- +2 DO BD
- IF Y=-1
- DO Q
- QUIT
- +3 DO ED
- IF Y=-1
- DO Q
- QUIT
- +4 DO ZIS
- IF POP
- DO Q
- QUIT
- +5 IF $DATA(IO("Q"))
- DO QUE
- DO Q
- QUIT
- +6 DO START
- QUIT
- +7 ;
- CL ; -- select clinic
- +1 DO ASK2^SDDIV
- IF Y<0
- QUIT
- SET VAUTNI=1
- DO CLINIC^VAUTOMA
- QUIT
- +2 ;
- BD ; -- beginning date
- +1 SET %DT="AEQ"
- SET %DT("A")="Select beginning date: "
- SET X=""
- DO ^%DT
- SET SDBD=Y
- QUIT
- +2 ;
- ED ; -- ending date
- +1 SET %DT="AEQ"
- SET %DT("A")="Select ending date: "
- SET X=""
- DO ^%DT
- SET SDED=Y
- QUIT
- +2 ;
- ZIS ; -- select device
- +1 SET %ZIS="PQ"
- DO ^%ZIS
- QUIT
- +2 ;
- QUE ; -- queued
- +1 KILL IO("Q")
- SET ZTRTN="START^ASDCWMA"
- SET ZTDESC="CLERK WHO MADE APPT LIST"
- +2 SET ZTSAVE("SDBD")=""
- SET ZTSAVE("SDED")=""
- SET ZTSAVE("VAUT*")=""
- SET ZTSAVE("DIV")=""
- +3 DO ^%ZTLOAD
- DO HOME^%ZIS
- KILL ZTSK
- QUIT
- +4 ;
- Q KILL X,Y,SDBD,SDED,VAUTC,VAUTD,POP,SDQUIT,N,P,D,SC,SD,ASDQT
- +1 DO ^%ZISC
- QUIT
- +2 ;
- START ;EP
- +1 SET ASDQT=0
- USE IO
- +2 IF VAUTC
- DO ALL
- QUIT
- +3 SET SD=""
- +4 FOR
- SET SD=$ORDER(VAUTC(SD))
- IF SD=""
- QUIT
- SET SC=VAUTC(SD)
- IF 'SC
- QUIT
- DO 1
- IF ASDQT
- QUIT
- +5 DO Q
- QUIT
- +6 ;
- ALL ; -- all clinics
- +1 SET SC=0
- FOR
- SET SC=$ORDER(^SC(SC))
- IF 'SC
- QUIT
- Begin DoDot:1
- +2 IF $ORDER(VAUTD(0))
- IF '$DATA(VAUTD(+$PIECE(^SC(SC,0),U,15)))
- QUIT
- +3 IF '$$ACTV^ASDUT(SC)
- QUIT
- DO 1
- End DoDot:1
- IF ASDQT
- QUIT
- +4 QUIT
- +5 ;
- 1 ; -- loop clinics
- +1 DO HD(0)
- +2 SET D=SDBD-.001
- +3 FOR
- SET D=$ORDER(^SC(+SC,"S",D))
- IF 'D
- QUIT
- IF D>(SDED+.9)
- QUIT
- Begin DoDot:1
- +4 SET P=0
- FOR
- SET P=$ORDER(^SC(+SC,"S",D,1,P))
- IF 'P
- QUIT
- Begin DoDot:2
- +5 SET N=^SC(+SC,"S",D,1,P,0)
- IF $Y>(IOSL-7)
- DO HD(1)
- IF ASDQT
- QUIT
- +6 WRITE !,$$D(D),?20,$$HRC^ASDUT(+N),?30,$$AGE(+N)
- +7 WRITE ?40,$$CLK($PIECE(N,U,6)),?65,$$D($PIECE(N,U,7))
- End DoDot:2
- IF ASDQT
- QUIT
- End DoDot:1
- IF ASDQT
- QUIT
- +8 IF IOST["C-"
- IF 'ASDQT
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y
- SET ASDQT=1
- +9 QUIT
- +10 ;
- HD(X) ; -- heading
- +1 IF IOST["C-"
- IF X
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y
- SET ASDQT=1
- IF 'Y
- QUIT
- +2 WRITE @IOF,!!,?35,$PIECE(^SC(+SC,0),U),!!,"DATE/TIME",?20,"HRCN"
- +3 WRITE ?30,"AGE",?40,"CLERK WHO MADE APPT",?65,"DATE APPT MADE",!!
- +4 QUIT
- +5 ;
- D(Y) ; -- date
- +1 NEW N,P,D
- +2 XECUTE ^DD("DD")
- QUIT Y
- +3 ;
- AGE(X) ; -- age
- +1 NEW N,D,P
- +2 QUIT $$VAL^XBDIQ1(9000001,X,1102.98)
- +3 ;
- CLK(X) ; -- clerk who made appt
- +1 NEW N,D,P
- +2 QUIT $EXTRACT($PIECE(^VA(200,X,0),U),1,20)
