ASDAL ; IHS/ADC/PDW/ENM - IHS APPT LIST CALLS ; [ 05/17/1999 1:51 PM ]
;;5.0;IHS SCHEDULING;**2**;MAR 25, 1999
; -- subrtns called by SDAL and SDAL0
;
ASK ;EP; called to ask IHS questions
K ASDQ
S DIR(0)="Y",DIR("B")="YES",DIR("A")="INCLUDE WALK-INS" ;IHS added
S DIR("?")="If you answer YES both walk-ins and chart requests will print"
D ^DIR K DIR I $D(DIRUT) S ASDQ="" Q
S ASDWI='Y
;I $$NOAMB,'$D(^XUSEC("SDZSUP",DUZ)) S ASDAMB=0 Q ;IHS/DSD/ENM 05/17/99
I $$NOAMB,'$D(^XUSEC("SDZSUP",DUZ)) S ASDAMB=0 G PHO ;IHS/DSD/ENM 05/17/99
S DIR(0)="Y",DIR("B")="NO",DIR("A")="INCLUDE WHO MADE APPT"
D ^DIR K DIR I $D(DIRUT) S ASDQ="" Q
S ASDAMB=Y
PHO K ASDPH K DIR S DIR(0)="Y",DIR("B")="NO" ;IHS/DSD/ENM 05/17/99 PHO ADD
S DIR("A")="INCLUDE PATIENT'S PHONE #" D ^DIR K DIR
I $D(DIRUT) S ASDPH="" Q
S ASDPH=Y
Q
;
HED ;EP; called by SDAL0 for IHS version of heading
NEW X
I SD1!(IOST["C-") W @IOF
W !?16,$$CONF^ASDUT
S (SDB,SD1)=1
I '$D(ASDT) S X=$$HTFM^XLFDT($H),ASDT=$$FMTE^XLFDT($E(X,1,12),"2P")
W !,"APPOINTMENTS FOR ",$P(^SC(SC,0),U,1)," CLINIC ON ",SDPD
W !?2,"TIME",?11,"PATIENT NAME",?33,"HRCN",?43,"DOB"
W ?53," LAB@",?62,"X-RAY@",?74,"EKG@"
W !?15,"OTHER INFORMATION",?55,"Printed: ",ASDT
S SDXX="",$P(SDXX,"=",81)="" W !,SDXX
Q
;
TYPE ;EP; prints type of appt
NEW X
I $X>15 W !!
I $P(^DPT(DFN,"S",SDT,0),U,7)=4 W ?12,"Walk-in/Chart Request" Q
S X=$G(^SC(SC,"S",SDT,1,K,"C")) Q:X=""
D TM^SDROUT0 W ?12,"Checked in at ",X
Q
;
AMB ;EP; prints appt made by if asked for
NEW X,Y
Q:'$G(ASDAMB)
S X=$P($G(^SC(SC,"S",SDT,1,K,0)),U,6),Y=$P($G(^(0)),U,7) Q:X=""
W !?15,"Made by ",$P($G(^VA(200,X,0)),U)," on ",$$FMTE^XLFDT(Y,"2D")
I $P($G(^VA(200,X,.13)),U,2)]"" W ?53,"Phone: ",$P(^(.13),U,2)
Q
;
SHORT(SC,DATE) ;EP -- short list of appt times,lengths, & other info\
NEW T,P,N,END,C,Y,X
S Y=DATE D DD^%DT W !!?15,"OTHER APPTS ALREADY SCHEDULED FOR ",Y
W !?15,$$REPEAT^XLFSTR("=",46),!
S END=DATE+.2400,T=DATE-.0001,C=0
F S T=$O(^SC(SC,"S",T)) Q:'T!(T>END) D
. S P=0 F S P=$O(^SC(SC,"S",T,1,P)) Q:'P D
.. S N=$G(^SC(SC,"S",T,1,P,0)) Q:N=""
.. S Y=T D DD^%DT
.. W !?2,$P(Y,"@",2),?10,$P(N,U,2)," MIN",?20,$E($P(N,U,4),1,59)
.. S C=C+1 I C#10=0 K DIR S DIR(0)="E",DIR("A")="Return to continue" D ^DIR K DIR
Q
;
DOB() ;EP; -- returns date of birth
N Y S Y=$P($G(^DPT(+$G(DFN),0)),U,3) X ^DD("DD") Q Y
;
WI() ;EP; -- returns 1 if appt to be excluded from the list
Q $S($G(ASDWI):$S($P(^DPT(DFN,"S",SDT,0),U,7)=4:1,1:0),1:0)
;
NOAMB() ; -- returns 1 if restrict viewing of who made appt turned on
Q $$VALI^XBDIQ1(40.8,$$DIV^ASDUT,9999999.12)
;
PHONE() ;EP; -- returns patient's phone number
I $G(ASDPH)'=1 Q ""
Q $P($G(^DPT(DFN,.13)),U)_" "
ASDAL ; IHS/ADC/PDW/ENM - IHS APPT LIST CALLS ; [ 05/17/1999 1:51 PM ]
+1 ;;5.0;IHS SCHEDULING;**2**;MAR 25, 1999
+2 ; -- subrtns called by SDAL and SDAL0
+3 ;
ASK ;EP; called to ask IHS questions
+1 KILL ASDQ
+2 ;IHS added
SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="INCLUDE WALK-INS"
+3 SET DIR("?")="If you answer YES both walk-ins and chart requests will print"
+4 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ASDQ=""
QUIT
+5 SET ASDWI='Y
+6 ;I $$NOAMB,'$D(^XUSEC("SDZSUP",DUZ)) S ASDAMB=0 Q ;IHS/DSD/ENM 05/17/99
+7 ;IHS/DSD/ENM 05/17/99
IF $$NOAMB
IF '$DATA(^XUSEC("SDZSUP",DUZ))
SET ASDAMB=0
GOTO PHO
+8 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="INCLUDE WHO MADE APPT"
+9 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ASDQ=""
QUIT
+10 SET ASDAMB=Y
PHO ;IHS/DSD/ENM 05/17/99 PHO ADD
KILL ASDPH
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+1 SET DIR("A")="INCLUDE PATIENT'S PHONE #"
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
SET ASDPH=""
QUIT
+3 SET ASDPH=Y
+4 QUIT
+5 ;
HED ;EP; called by SDAL0 for IHS version of heading
+1 NEW X
+2 IF SD1!(IOST["C-")
WRITE @IOF
+3 WRITE !?16,$$CONF^ASDUT
+4 SET (SDB,SD1)=1
+5 IF '$DATA(ASDT)
SET X=$$HTFM^XLFDT($HOROLOG)
SET ASDT=$$FMTE^XLFDT($EXTRACT(X,1,12),"2P")
+6 WRITE !,"APPOINTMENTS FOR ",$PIECE(^SC(SC,0),U,1)," CLINIC ON ",SDPD
+7 WRITE !?2,"TIME",?11,"PATIENT NAME",?33,"HRCN",?43,"DOB"
+8 WRITE ?53," LAB@",?62,"X-RAY@",?74,"EKG@"
+9 WRITE !?15,"OTHER INFORMATION",?55,"Printed: ",ASDT
+10 SET SDXX=""
SET $PIECE(SDXX,"=",81)=""
WRITE !,SDXX
+11 QUIT
+12 ;
TYPE ;EP; prints type of appt
+1 NEW X
+2 IF $X>15
WRITE !!
+3 IF $PIECE(^DPT(DFN,"S",SDT,0),U,7)=4
WRITE ?12,"Walk-in/Chart Request"
QUIT
+4 SET X=$GET(^SC(SC,"S",SDT,1,K,"C"))
IF X=""
QUIT
+5 DO TM^SDROUT0
WRITE ?12,"Checked in at ",X
+6 QUIT
+7 ;
AMB ;EP; prints appt made by if asked for
+1 NEW X,Y
+2 IF '$GET(ASDAMB)
QUIT
+3 SET X=$PIECE($GET(^SC(SC,"S",SDT,1,K,0)),U,6)
SET Y=$PIECE($GET(^(0)),U,7)
IF X=""
QUIT
+4 WRITE !?15,"Made by ",$PIECE($GET(^VA(200,X,0)),U)," on ",$$FMTE^XLFDT(Y,"2D")
+5 IF $PIECE($GET(^VA(200,X,.13)),U,2)]""
WRITE ?53,"Phone: ",$PIECE(^(.13),U,2)
+6 QUIT
+7 ;
SHORT(SC,DATE) ;EP -- short list of appt times,lengths, & other info\
+1 NEW T,P,N,END,C,Y,X
+2 SET Y=DATE
DO DD^%DT
WRITE !!?15,"OTHER APPTS ALREADY SCHEDULED FOR ",Y
+3 WRITE !?15,$$REPEAT^XLFSTR("=",46),!
+4 SET END=DATE+.2400
SET T=DATE-.0001
SET C=0
+5 FOR
SET T=$ORDER(^SC(SC,"S",T))
IF 'T!(T>END)
QUIT
Begin DoDot:1
+6 SET P=0
FOR
SET P=$ORDER(^SC(SC,"S",T,1,P))
IF 'P
QUIT
Begin DoDot:2
+7 SET N=$GET(^SC(SC,"S",T,1,P,0))
IF N=""
QUIT
+8 SET Y=T
DO DD^%DT
+9 WRITE !?2,$PIECE(Y,"@",2),?10,$PIECE(N,U,2)," MIN",?20,$EXTRACT($PIECE(N,U,4),1,59)
+10 SET C=C+1
IF C#10=0
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Return to continue"
DO ^DIR
KILL DIR
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
DOB() ;EP; -- returns date of birth
+1 NEW Y
SET Y=$PIECE($GET(^DPT(+$GET(DFN),0)),U,3)
XECUTE ^DD("DD")
QUIT Y
+2 ;
WI() ;EP; -- returns 1 if appt to be excluded from the list
+1 QUIT $SELECT($GET(ASDWI):$SELECT($PIECE(^DPT(DFN,"S",SDT,0),U,7)=4:1,1:0),1:0)
+2 ;
NOAMB() ; -- returns 1 if restrict viewing of who made appt turned on
+1 QUIT $$VALI^XBDIQ1(40.8,$$DIV^ASDUT,9999999.12)
+2 ;
PHONE() ;EP; -- returns patient's phone number
+1 IF $GET(ASDPH)'=1
QUIT ""
+2 QUIT $PIECE($GET(^DPT(DFN,.13)),U)_" "
