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)
