SDAMEP3 ;ALB/CAW - Extended Display (Appt. Event Log) ; 16 May 2001 6:31 PM
;;5.3;Scheduling;**20,241,1001,1005,1015,1016**;Aug 13, 1993;Build 20
;IHS/ANMC/LJF 12/13/2000 added display of date routing slip printed
;IHS/ITSC/WAR 08/19/2004 PATCH 1001 quit added by pass VA wait time display
;IHS/OIT/LJF 12/30/2005 PATCH 1005 added code to wrap long cancel remarks
;
APLOG ;
D SET^SDAMEP1(" *** Appointment Event Log ***")
D CNTRL^VALM10(SDLN,24,29,IOINHI,IOINORM)
D SET^SDAMEP1($$EVENT("Event","Date","User"))
D SET^SDAMEP1($$EVENT("-----","----","----"))
D SET^SDAMEP1($$EVENT("Appt Made",$S($G(SDSC(44.003,SDDA,8))]"":SDSC(44.003,SDDA,8),1:$G(SDPT(2.98,SDT,20))),$S($G(SDSC(44.003,SDDA,7))]"":SDSC(44.003,SDDA,7),1:$G(SDPT(2.98,SDT,19)))))
;
D SET^SDAMEP1($$EVENT("Routing Slip Printed",$$FMTE^XLFDT($P(^DPT(DFN,"S",SDT,0),U,13)),"")) ;IHS/ANMC/LJF 12/13/2000
;
D SET^SDAMEP1($$EVENT("Check In",$G(SDSC(44.003,SDDA,309)),$G(SDSC(44.003,SDDA,302))))
D SET^SDAMEP1($$EVENT("Check Out",$G(SDSC(44.003,SDDA,303)),$G(SDSC(44.003,SDDA,304))))
D SET^SDAMEP1($$EVENT("Check Out Entered",$G(SDSC(44.003,SDDA,306)),""))
D SET^SDAMEP1($$EVENT("No-Show/Cancel",$G(SDPT(2.98,SDT,15)),$G(SDPT(2.98,SDT,14)))),SET^SDAMEP1("")
;
S X=""
S X=$$SETSTR^VALM1(" Checked Out:",X,7,SDWIDTH)
S X=$$SETSTR^VALM1($S($G(SDOE(409.68,+SDOE,.07))]"":"YES",1:""),X,SDFSTCOL+5,30)
D SET^SDAMEP1(X)
;
S X=""
S X=$$SETSTR^VALM1(" Cancel Reason:",X,5,SDWIDTH)
S X=$$SETSTR^VALM1(SDPT(2.98,SDT,16),X,SDFSTCOL+5,30)
D SET^SDAMEP1(X)
;
S X=""
S X=$$SETSTR^VALM1(" Cancel Remark:",X,5,SDWIDTH)
;S X=$$SETSTR^VALM1(SDPT(2.98,SDT,17),X,SDFSTCOL+5,50) ;ihs/cmi/maw removed patch 1016
;D SET^SDAMEP1(X)
;
;
;IHS/OIT/LJF 12/30/2005 PATCH 1005 wrap to multiple lines if longer than 60 characters
;S X=$$SETSTR^VALM1(SDPT(2.98,SDT,17),X,SDFSTCOL+5,50)
;D SET^SDAMEP1(X)
NEW BSDR,I,BSDSAV S BSDSAV=X D WRAP^BDGF(SDPT(2.98,SDT,17),50,.BSDR)
S X=BSDSAV,X=$$SETSTR^VALM1(BSDR(1),X,SDFSTCOL+5,50) D SET^SDAMEP1(X) ;first line as before
F I=2:1 Q:'$D(BSDR(I)) S X=$$REPEAT^XLFSTR(" ",SDWIDTH),X=$$SETSTR^VALM1(BSDR(I),X,SDFSTCOL+5,50) D SET^SDAMEP1(X)
;PATCH 1005 end of changes
;
S X=""
S X=$$SETSTR^VALM1(" Rebooked Date:",X,5,SDWIDTH)
S X=$$SETSTR^VALM1(SDPT(2.98,SDT,12),X,SDFSTCOL+5,20)
D SET^SDAMEP1(X)
Q ;IHS/ITSC/WAR 8/19/2004 PATCH #1001 quit was needed
CWT ;Clinic Wait Time Information
N SDCWT,SDCWT1,SDCWT2
;Get internal data values
F SDCWT=3,20,25:1:28 S SDCWT(SDCWT)=SDPTI(2.98,SDT,SDCWT,"I")
;Wait time data applicable?
S SDCWT=1 S:$E(SDCWT(3))="C" SDCWT=0
S SDCWT1=SDCWT(20),SDCWT2=SDCWT(27)
;Calculate Wait Time1
S SDCWT1=$S(SDCWT1<1:"",SDT<SDCWT1:0,1:$$FMDIFF^XLFDT(SDT,SDCWT1,1))
;Calculate Wait Time2
S:'$$CWT3^SCRPW75(SDT,SDCWT(26),SDCWT(27),SDCWT(28),.SDCWT2) SDCWT2=""
S:+SDCWT1=SDCWT1 SDCWT1=SDCWT1_" day"_$S(SDCWT1=1:"",1:"s")
S:+SDCWT2=SDCWT2 SDCWT2=SDCWT2_" day"_$S(SDCWT2=1:"",1:"s")
D SET^SDAMEP1(" *** Clinic Wait Time Information ***")
D CNTRL^VALM10(SDLN,20,40,IOINHI,IOINORM)
D SET^SDAMEP1("")
;
S X=""
S X=$$SETSTR^VALM1(" Request type:",X,7,SDWIDTH+6)
S X=$$SETSTR^VALM1($S('SDCWT:"N/A",$G(SDPT(2.98,SDT,25))]"":SDPT(2.98,SDT,25),1:"Unknown"),X,SDFSTCOL+10,50)
D SET^SDAMEP1(X)
;
S X=""
S X=$$SETSTR^VALM1("'Next Available' Type:",X,5,SDWIDTH+6)
S X=$$SETSTR^VALM1($S('SDCWT:"N/A",1:SDPT(2.98,SDT,26)),X,SDFSTCOL+10,50)
D SET^SDAMEP1(X)
;
S X=""
S X=$$SETSTR^VALM1(" Desired date:",X,5,SDWIDTH+6)
S X=$$SETSTR^VALM1($S('SDCWT:"N/A",1:SDPT(2.98,SDT,27)),X,SDFSTCOL+10,50)
D SET^SDAMEP1(X)
;
S X=""
S X=$$SETSTR^VALM1(" Follow-up visit:",X,5,SDWIDTH+6)
S X=$$SETSTR^VALM1($S('SDCWT:"N/A",1:SDPT(2.98,SDT,28)_$S($L(SDPT(2.98,SDT,28)):" (computed)",1:"")),X,SDFSTCOL+10,50)
D SET^SDAMEP1(X)
;
S X=""
S X=$$SETSTR^VALM1(" Clinic Wait Time1:",X,5,SDWIDTH+6)
S X=$$SETSTR^VALM1($S('SDCWT:"N/A",1:SDCWT1),X,SDFSTCOL+10,50)
D SET^SDAMEP1(X)
;
S X=""
S X=$$SETSTR^VALM1(" Clinic Wait Time2:",X,5,SDWIDTH+6)
S X=$$SETSTR^VALM1($S('SDCWT:"N/A",1:SDCWT2),X,SDFSTCOL+10,50)
D SET^SDAMEP1(X)
D SET^SDAMEP1("")
I SDCWT D Q
.D SET^SDAMEP1("NOTE: Clinic Wait Time1 represents the difference between the date the")
.D SET^SDAMEP1(" appointment was entered and the date it was performed. Clinic Wait")
.D SET^SDAMEP1(" Time2 represents the difference between the 'desired date' and the")
.D SET^SDAMEP1(" date the appointment was performed.")
.Q
D SET^SDAMEP1("")
D SET^SDAMEP1("NOTE: Clinic Wait Time data is not applicable for appointments that have a")
D SET^SDAMEP1(" status of 'cancelled by clinic'.")
D SET^SDAMEP1("")
Q
;
EVENT(TYPE,TIME,USER) ;
Q $$SETSTR^VALM1(TYPE,$$SETSTR^VALM1(TIME,$$SETSTR^VALM1(USER,"",50,30),25,21),2,20)
;
SDAMEP3 ;ALB/CAW - Extended Display (Appt. Event Log) ; 16 May 2001 6:31 PM
+1 ;;5.3;Scheduling;**20,241,1001,1005,1015,1016**;Aug 13, 1993;Build 20
+2 ;IHS/ANMC/LJF 12/13/2000 added display of date routing slip printed
+3 ;IHS/ITSC/WAR 08/19/2004 PATCH 1001 quit added by pass VA wait time display
+4 ;IHS/OIT/LJF 12/30/2005 PATCH 1005 added code to wrap long cancel remarks
+5 ;
APLOG ;
+1 DO SET^SDAMEP1(" *** Appointment Event Log ***")
+2 DO CNTRL^VALM10(SDLN,24,29,IOINHI,IOINORM)
+3 DO SET^SDAMEP1($$EVENT("Event","Date","User"))
+4 DO SET^SDAMEP1($$EVENT("-----","----","----"))
+5 DO SET^SDAMEP1($$EVENT("Appt Made",$SELECT($GET(SDSC(44.003,SDDA,8))]"":SDSC(44.003,SDDA,8),1:$GET(SDPT(2.98,SDT,20))),$SELECT($GET(SDSC(44.003,SDDA,7))]"":SDSC(44.003,SDDA,7),1:$GET(SDPT(2.98,SDT,19)))))
+6 ;
+7 ;IHS/ANMC/LJF 12/13/2000
DO SET^SDAMEP1($$EVENT("Routing Slip Printed",$$FMTE^XLFDT($PIECE(^DPT(DFN,"S",SDT,0),U,13)),""))
+8 ;
+9 DO SET^SDAMEP1($$EVENT("Check In",$GET(SDSC(44.003,SDDA,309)),$GET(SDSC(44.003,SDDA,302))))
+10 DO SET^SDAMEP1($$EVENT("Check Out",$GET(SDSC(44.003,SDDA,303)),$GET(SDSC(44.003,SDDA,304))))
+11 DO SET^SDAMEP1($$EVENT("Check Out Entered",$GET(SDSC(44.003,SDDA,306)),""))
+12 DO SET^SDAMEP1($$EVENT("No-Show/Cancel",$GET(SDPT(2.98,SDT,15)),$GET(SDPT(2.98,SDT,14))))
DO SET^SDAMEP1("")
+13 ;
+14 SET X=""
+15 SET X=$$SETSTR^VALM1(" Checked Out:",X,7,SDWIDTH)
+16 SET X=$$SETSTR^VALM1($SELECT($GET(SDOE(409.68,+SDOE,.07))]"":"YES",1:""),X,SDFSTCOL+5,30)
+17 DO SET^SDAMEP1(X)
+18 ;
+19 SET X=""
+20 SET X=$$SETSTR^VALM1(" Cancel Reason:",X,5,SDWIDTH)
+21 SET X=$$SETSTR^VALM1(SDPT(2.98,SDT,16),X,SDFSTCOL+5,30)
+22 DO SET^SDAMEP1(X)
+23 ;
+24 SET X=""
+25 SET X=$$SETSTR^VALM1(" Cancel Remark:",X,5,SDWIDTH)
+26 ;S X=$$SETSTR^VALM1(SDPT(2.98,SDT,17),X,SDFSTCOL+5,50) ;ihs/cmi/maw removed patch 1016
+27 ;D SET^SDAMEP1(X)
+28 ;
+29 ;
+30 ;IHS/OIT/LJF 12/30/2005 PATCH 1005 wrap to multiple lines if longer than 60 characters
+31 ;S X=$$SETSTR^VALM1(SDPT(2.98,SDT,17),X,SDFSTCOL+5,50)
+32 ;D SET^SDAMEP1(X)
+33 NEW BSDR,I,BSDSAV
SET BSDSAV=X
DO WRAP^BDGF(SDPT(2.98,SDT,17),50,.BSDR)
+34 ;first line as before
SET X=BSDSAV
SET X=$$SETSTR^VALM1(BSDR(1),X,SDFSTCOL+5,50)
DO SET^SDAMEP1(X)
+35 FOR I=2:1
IF '$DATA(BSDR(I))
QUIT
SET X=$$REPEAT^XLFSTR(" ",SDWIDTH)
SET X=$$SETSTR^VALM1(BSDR(I),X,SDFSTCOL+5,50)
DO SET^SDAMEP1(X)
+36 ;PATCH 1005 end of changes
+37 ;
+38 SET X=""
+39 SET X=$$SETSTR^VALM1(" Rebooked Date:",X,5,SDWIDTH)
+40 SET X=$$SETSTR^VALM1(SDPT(2.98,SDT,12),X,SDFSTCOL+5,20)
+41 DO SET^SDAMEP1(X)
+42 ;IHS/ITSC/WAR 8/19/2004 PATCH #1001 quit was needed
QUIT
CWT ;Clinic Wait Time Information
+1 NEW SDCWT,SDCWT1,SDCWT2
+2 ;Get internal data values
+3 FOR SDCWT=3,20,25:1:28
SET SDCWT(SDCWT)=SDPTI(2.98,SDT,SDCWT,"I")
+4 ;Wait time data applicable?
+5 SET SDCWT=1
IF $EXTRACT(SDCWT(3))="C"
SET SDCWT=0
+6 SET SDCWT1=SDCWT(20)
SET SDCWT2=SDCWT(27)
+7 ;Calculate Wait Time1
+8 SET SDCWT1=$SELECT(SDCWT1<1:"",SDT<SDCWT1:0,1:$$FMDIFF^XLFDT(SDT,SDCWT1,1))
+9 ;Calculate Wait Time2
+10 IF '$$CWT3^SCRPW75(SDT,SDCWT(26),SDCWT(27),SDCWT(28),.SDCWT2)
SET SDCWT2=""
+11 IF +SDCWT1=SDCWT1
SET SDCWT1=SDCWT1_" day"_$SELECT(SDCWT1=1:"",1:"s")
+12 IF +SDCWT2=SDCWT2
SET SDCWT2=SDCWT2_" day"_$SELECT(SDCWT2=1:"",1:"s")
+13 DO SET^SDAMEP1(" *** Clinic Wait Time Information ***")
+14 DO CNTRL^VALM10(SDLN,20,40,IOINHI,IOINORM)
+15 DO SET^SDAMEP1("")
+16 ;
+17 SET X=""
+18 SET X=$$SETSTR^VALM1(" Request type:",X,7,SDWIDTH+6)
+19 SET X=$$SETSTR^VALM1($SELECT('SDCWT:"N/A",$GET(SDPT(2.98,SDT,25))]"":SDPT(2.98,SDT,25),1:"Unknown"),X,SDFSTCOL+10,50)
+20 DO SET^SDAMEP1(X)
+21 ;
+22 SET X=""
+23 SET X=$$SETSTR^VALM1("'Next Available' Type:",X,5,SDWIDTH+6)
+24 SET X=$$SETSTR^VALM1($SELECT('SDCWT:"N/A",1:SDPT(2.98,SDT,26)),X,SDFSTCOL+10,50)
+25 DO SET^SDAMEP1(X)
+26 ;
+27 SET X=""
+28 SET X=$$SETSTR^VALM1(" Desired date:",X,5,SDWIDTH+6)
+29 SET X=$$SETSTR^VALM1($SELECT('SDCWT:"N/A",1:SDPT(2.98,SDT,27)),X,SDFSTCOL+10,50)
+30 DO SET^SDAMEP1(X)
+31 ;
+32 SET X=""
+33 SET X=$$SETSTR^VALM1(" Follow-up visit:",X,5,SDWIDTH+6)
+34 SET X=$$SETSTR^VALM1($SELECT('SDCWT:"N/A",1:SDPT(2.98,SDT,28)_$SELECT($LENGTH(SDPT(2.98,SDT,28)):" (computed)",1:"")),X,SDFSTCOL+10,50)
+35 DO SET^SDAMEP1(X)
+36 ;
+37 SET X=""
+38 SET X=$$SETSTR^VALM1(" Clinic Wait Time1:",X,5,SDWIDTH+6)
+39 SET X=$$SETSTR^VALM1($SELECT('SDCWT:"N/A",1:SDCWT1),X,SDFSTCOL+10,50)
+40 DO SET^SDAMEP1(X)
+41 ;
+42 SET X=""
+43 SET X=$$SETSTR^VALM1(" Clinic Wait Time2:",X,5,SDWIDTH+6)
+44 SET X=$$SETSTR^VALM1($SELECT('SDCWT:"N/A",1:SDCWT2),X,SDFSTCOL+10,50)
+45 DO SET^SDAMEP1(X)
+46 DO SET^SDAMEP1("")
+47 IF SDCWT
Begin DoDot:1
+48 DO SET^SDAMEP1("NOTE: Clinic Wait Time1 represents the difference between the date the")
+49 DO SET^SDAMEP1(" appointment was entered and the date it was performed. Clinic Wait")
+50 DO SET^SDAMEP1(" Time2 represents the difference between the 'desired date' and the")
+51 DO SET^SDAMEP1(" date the appointment was performed.")
+52 QUIT
End DoDot:1
QUIT
+53 DO SET^SDAMEP1("")
+54 DO SET^SDAMEP1("NOTE: Clinic Wait Time data is not applicable for appointments that have a")
+55 DO SET^SDAMEP1(" status of 'cancelled by clinic'.")
+56 DO SET^SDAMEP1("")
+57 QUIT
+58 ;
EVENT(TYPE,TIME,USER) ;
+1 QUIT $$SETSTR^VALM1(TYPE,$$SETSTR^VALM1(TIME,$$SETSTR^VALM1(USER,"",50,30),25,21),2,20)
+2 ;
