SCRPW76 ;BP-OIFO/KEITH,ESW - Clinic appointment availability extract (cont.) ; 5/28/03 4:02pm
;;5.3;Scheduling;**223,291**;AUG 13, 1993
;
HINI ;Initialize header variables
N %,%H,%I,X,X1,X2
S SDLINE="",$P(SDLINE,"-",$S(SDPAST:133,1:(SDIOM+1)))="",SDPAGE=1,SDPG=0
D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2)
S SDTITL="<*> Clinic Appointment Availability Report <*>"
Q
;
HDR(SDTY,SDREPORT,SDIV,SDCP,SC) ;Print header
;Input: SDTY=type of header where:
; '0'=negative report
; '1'=detailed report
; '2'=division summary
; '3'=facility summary
;Input: SDREPORT=report output element where:
; '1'='next ava.' appt. information
; '2'='follow up' appt. information
; '3'='non-follow up' appt. information
;Input: SDIV=division name^division number
;Input: SDCP=credit pair
;Input: SC=clinic ifn
;
Q:SDOUT
I $G(SDXM) D HDRXM(SDREPORT) Q
I $E(IOST)="C",SDPG N DIR S DIR(0)="E" W ! D ^DIR S SDOUT=Y'=1 Q:SDOUT
N SDX,SDI D STOP Q:SDOUT
W:SDPG!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)
W SDLINE,!?(SDIOM-$L(SDTITL)\2),SDTITL
I SDREPORT=1,'SDPAST S SDX="Clinic availability data"
I SDREPORT=1,SDPAST S SDX="Clinic availability and 'next available' appointment data"
I SDREPORT=2 S SDX="'Follow up' appointment data"
I SDREPORT=3 S SDX="'Non-follow up' appointment data"
I SDREPORT=4 S SDX="Listing of patient appointments"
I SDREPORT=5 S SDX="Listing of appointments for selected patient"
W !?(SDIOM-$L(SDX)\2),SDX
D HDRX(SDTY) Q:SDOUT S SDI=0
I $G(SDREPORT)'=5 F S SDI=$O(SDTIT(SDI)) Q:'SDI W !?(SDIOM-$L(SDTIT(SDI))\2),SDTIT(SDI)
I $G(SDREPORT)=5 Q:'$O(SDTIT("")) D
.N SD F SD=1,2 W !?(SDIOM-$L(SDTIT(SD))\2),SDTIT(SD)
.W !,SDTIT(3),?100,SDTIT(4),!,SDTIT(5),?100,SDTIT(6)
W !,SDLINE
W !,"For clinic availability dates ",SDPBDT," through ",SDPEDT
W !,"Date printed: ",SDPNOW,?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE
W !,SDLINE
S SDPAGE=SDPAGE+1,SDPG=1 D:SDTY SUBT(SDTY,SDREPORT) Q
;
HDRX(SDTY) ;Extra header lines
K SDTIT
Q:SDTY=0 S SDIV=$G(SDIV)
I SDTY=3 S SDTIT(1)="Facility Summary" Q
N SDDV S SDDV=$P(SDIV,U)_" ("_$P(SDIV,U,2)_")"
I SDTY=2 S SDTIT(1)="Summary for division: "_SDDV Q
S SDTIT(1)="Division: "_SDDV
S:SDSORT="CP" SDTIT(2)="For clinics with credit pair: "_$$OTX^SCRPW73("CP")
I $G(SDREPORT)=5 D
.S:SDSORT="CP" SDTIT(2)="For clinics with selected credit pair"
.S:SDSORT="CA" SDTIT(2)="For all clinics"
.S:SDSORT="CL" SDTIT(2)="For clinics selected by name"
.N DA,DIC,DIQ,DR
.S DIC=2,SDPT=DIC,DA=$G(DFN) F DR=.01,.09 N SDPT,SDARR S DIQ="SDARR(",DIQ(0)="I" D EN^DIQ1 D
..I DR=.01 S SDTIT(3)="Patient: "_SDARR(2,DA,.01,"I")
..I DR=.09 S SDTIT(4)="SSN: "_SDARR(2,DA,.09,"I")
.S SDTIT(5)="Clinic: "_$P(^SC(SC,0),U)
.S SDTIT(6)="Clinic Stop Code Pair: "_SDCP
E S SDTIT(3)="Detail for clinic: "_$$OTX^SCRPW73("CL")
Q
;
SUBT(SDTY,SDREPORT) ;Print subtitles
D:SDREPORT=1 SUBT1 D:SDREPORT=2 SUBT2
D:SDREPORT=3 SUBT3 D:SDREPORT=4 SUBT4
D:SDREPORT=5 SUBT5
Q
;
SUBT1 N SDI
W !?(SDCOL+44),"Ava.",?(SDCOL+51),"Pct."
I SDPAST D
.F SDI=0:1:3 W ?(SDCOL+63+(14*SDI)),"--Type '",SDI,"'---"
.W ?120,"% NNA % NA" Q
W ! W:SDTY>1 ?(SDCOL),"Credit Pair"
W ?(SDCOL+35),"Clinic",?(SDCOL+43),"Appt.",?(SDCOL+50),"Slots"
I SDPAST D
.W ?(SDCOL+56),"Clinic"
.F SDI=0:1:3 W ?(SDCOL+65+(14*SDI)),"Sch. Wait"
.W ?122,"<31 <31" Q
W !?(SDCOL+4),$S(SDTY=1:"Availability Date",1:"Clinic Name")
W ?(SDCOL+33),"Capacity",?(SDCOL+43),"Slots",?(SDCOL+51),"Ava."
I SDPAST D
.W ?(SDCOL+58),"Enc."
.F SDI=0:1:3 W ?(SDCOL+64+(14*SDI)),"Appts Time"
.W ?121,"Days Days"
W !?(SDCOL),$E(SDLINE,1,($S(SDPAST:132,1:58)))
Q
;
SUBT2 N SDI
W !?48,"Next",?54,$E(SDLINE,1,24),"Non-next Available Appointments",$E(SDLINE,1,23)
W !?40,"Next Ava. 0-1 0-1 2-7 2-7 8-30 8-30 31-60 31-60 >60 >60"
W ! W:SDTY>1 "Credit Pair" W ?40,"Ava. Wait"
F SDI=56:16:121 W ?(SDI),"Days Wait"
W !?4,$S(SDTY=1:"Availability Date",1:"Clinic Name")
F SDI=39:16:120 W ?(SDI),"Appts Time"
W !,SDLINE
Q
;
SUBT3 N SDI
W !?38,"Next",?43,$E(SDLINE,1,29),"Non-next Available Appointments",$E(SDLINE,1,29)
W !?32,"Next Ava. 0-1 0-1 0-1 2-7 2-7 2-7 8-30 8-30 8-30 31-60 31-60 31-60 >60 >60 >60"
W ! W:SDTY>1 "Credit Pair" W ?32,"Ava. Wait"
F SDI=44:18:117 W ?(SDI),"Days Wait Wait"
W !?4,$S(SDTY=1:"Availability Date",1:"Clinic Name"),?31,"Appts Time1"
F SDI=43:18:116 W ?(SDI),"Appts Time1 Time2"
W !,SDLINE
Q
;
SUBT4 W !?96,"Next",!,"Date",?96,"Ava. Date Wait Wait"
W !,"Scheduled Patient Name SSN Appointment Date Scheduling Request Type Ind. Desired F/U Time1 Time2"
W !,SDLINE
Q
;
SUBT5 W !?11,"SCHEDULING",?63,"TIME",!,"DATE",?11,"REQUEST",?31,"DATE",?58,"WAIT",?63,"TO",?68,"APPT",?96,"APPT",?102,"COMPLETION"
W !,"SCHEDULED",?11,"TYPE",?31,"DESIRED",?42,"APPT DATE/TIME",?58,"TIME",?63,"APPT",?68,"TYPE",?73,"F/U",?79,"REBOOK DATE",?96,"STAT",?102,"DATE",?113,"SCHEDULER"
W !,SDLINE
Q
HDRXM(SDREPORT) ;Create header in mail message
;Input: SDREPORT=report element to print
;
N SDX,SDI,SDZ
I SDPAGE>1 F SDI=1:1:5 D XMTX("")
D XMTX($E(SDLINE,1,$S('SDPAST:79,1:132)))
S SDZ="",$E(SDZ,($S(SDPAST:132,1:79)-$L(SDTITL)\2))=SDTITL D XMTX(SDZ)
I SDREPORT=1,'SDPAST S SDX="Clinic availability data"
I SDREPORT=1,SDPAST S SDX="Clinic availability and 'next available' appointment data"
I SDREPORT=2 S SDX="'Follow up' appointment data"
I SDREPORT=3 S SDX="'Non-follow up' appointment data"
I SDREPORT=4 S SDX="Listing of patient appointments"
I SDREPORT=5 S SDX="Listing of appointments for selected patient"
S SDZ="",$E(SDZ,($S(SDPAST:132,1:79)-$L(SDX)\2))=SDX D XMTX(SDZ)
D HDRX(SDTY) S SDI=0
F S SDI=$O(SDTIT(SDI)) Q:'SDI S SDZ="" D
.S $E(SDZ,($S(SDPAST:130,1:79)-$L(SDTIT(SDI))\2))=SDTIT(SDI) D XMTX(SDZ)
.Q
D XMTX($E(SDLINE,1,$S('SDPAST:79,1:132)))
D XMTX("For clinic availability dates "_SDPBDT_" through "_SDPEDT)
S SDZ="Date extracted: "_SDPNOW
D XMTX(SDZ),XMTX($E(SDLINE,1,$S('SDPAST:79,1:132)))
S SDPAGE=SDPAGE+1 D:SDTY SUBTXM(SDTY,SDREPORT) Q
;
SUBTXM(SDTY,SDREPORT) ;Create message header subtitles
N SDZ
D:SDREPORT=1 STXM1 D:SDREPORT=2 STXM2
D:SDREPORT=3 STXM3 D:SDREPORT=4 STXM4
Q
;
STXM1 N SDI
S SDZ="",$E(SDZ,45)="Ava.",$E(SDZ,52)="Pct."
I SDPAST D
.F SDI=0:1:3 D
..S $E(SDZ,(SDCOL+64+(14*SDI)))="--Type '"_SDI_"'---"
..Q
.S $E(SDZ,121)="% NNA % NA"
.Q
D XMTX(SDZ)
S SDZ="" I SDTY>1 S SDZ="Credit Pair"
S $E(SDZ,36)="Clinic",$E(SDZ,44)="Appt.",$E(SDZ,51)="Slots"
I SDPAST D
.S $E(SDZ,57)="Clinic"
.F SDI=0:1:3 S $E(SDZ,(SDCOL+66+(14*SDI)))="Sch. Wait"
.S $E(SDZ,123)="<31 <31"
.Q
D XMTX(SDZ)
S SDZ="",$E(SDZ,4)=$S(SDTY=1:"Availability Date",1:"Clinic Name")
S $E(SDZ,34)="Capacity",$E(SDZ,44)="Slots",$E(SDZ,52)="Ava."
I SDPAST D
.S $E(SDZ,59)="Enc."
.F SDI=0:1:3 S $E(SDZ,(SDCOL+65+(14*SDI)))="Appts Time"
.S $E(SDZ,122)="Days Days"
.Q
D XMTX(SDZ)
S SDZ="",$E(SDZ,$S(SDTY>1:1,1:4))=$E(SDLINE,1,$S(SDPAST:132,1:58))
D XMTX(SDZ)
Q
;
STXM2 N SDI S SDZ=""
S $E(SDZ,49)="Next"
S $E(SDZ,55)=$E(SDLINE,1,24)_"Non-next Available Appointments"_$E(SDLINE,1,23)
D XMTX(SDZ) S SDZ=""
S $E(SDZ,41)="Next Ava. 0-1 0-1 2-7 2-7 8-30 8-30 31-60 31-60 >60 >60"
D XMTX(SDZ) S SDZ=""
S:SDTY>1 SDZ="Credit Pair" S $E(SDZ,41)="Ava. Wait"
F SDI=57:16:121 S $E(SDZ,SDI)="Days Wait"
D XMTX(SDZ) S SDZ=""
S $E(SDZ,4)=$S(SDTY=1:"Availability Date",1:"Clinic Name")
F SDI=40:16:120 S $E(SDZ,SDI)="Appts Time"
D XMTX(SDZ) S SDZ=""
S SDZ=SDLINE D XMTX(SDZ)
Q
;
STXM3 N SDI S SDZ=""
S $E(SDZ,39)="Next"
S $E(SDZ,44)=$E(SDLINE,1,29)_"Non-next Available Appointments"_$E(SDLINE,1,29)
D XMTX(SDZ) S SDZ=""
S $E(SDZ,33)="Next Ava. 0-1 0-1 0-1 2-7 2-7 2-7 8-30 8-30 8-30 31-60 31-60 31-60 >60 >60 >60"
D XMTX(SDZ) S SDZ=""
S:SDTY>1 SDZ="Credit Pair" S $E(SDZ,33)="Ava. Wait"
F SDI=45:18:117 S $E(SDZ,SDI)="Days Wait Wait"
D XMTX(SDZ) S SDZ=""
S $E(SDZ,4)=$S(SDTY=1:"Availability Date",1:"Clinic Name") S $E(SDZ,32)="Appts Time1"
F SDI=44:18:116 S $E(SDZ,SDI)="Appts Time1 Time2"
D XMTX(SDZ) S SDZ=""
S SDZ=SDLINE D XMTX(SDZ)
Q
;
STXM4 S SDZ=""
S $E(SDZ,96)="Next"
D XMTX(SDZ) S SDZ=""
S SDZ="Date",$E(SDZ,96)="Ava. Date Wait Wait"
D XMTX(SDZ) S SDZ=""
S SDZ="Scheduled Patient Name SSN Appointment Date Scheduling Request Type Ind. Desired F/U Time1 Time2"
D XMTX(SDZ) S SDZ=""
S SDZ=SDLINE D XMTX(SDZ)
Q
;
STOP ;Check for stop task request
S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
;
XMTX(SDX) ;Set mail message text line
;Input: SDX=text value
S ^TMP("SDXM",$J,SDXM)=SDX,SDXM=SDXM+1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW76 9015 printed Nov 22, 2024@17:54:05 Page 2
SCRPW76 ;BP-OIFO/KEITH,ESW - Clinic appointment availability extract (cont.) ; 5/28/03 4:02pm
+1 ;;5.3;Scheduling;**223,291**;AUG 13, 1993
+2 ;
HINI ;Initialize header variables
+1 NEW %,%H,%I,X,X1,X2
+2 SET SDLINE=""
SET $PIECE(SDLINE,"-",$SELECT(SDPAST:133,1:(SDIOM+1)))=""
SET SDPAGE=1
SET SDPG=0
+3 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET SDPNOW=$PIECE(Y,":",1,2)
+4 SET SDTITL="<*> Clinic Appointment Availability Report <*>"
+5 QUIT
+6 ;
HDR(SDTY,SDREPORT,SDIV,SDCP,SC) ;Print header
+1 ;Input: SDTY=type of header where:
+2 ; '0'=negative report
+3 ; '1'=detailed report
+4 ; '2'=division summary
+5 ; '3'=facility summary
+6 ;Input: SDREPORT=report output element where:
+7 ; '1'='next ava.' appt. information
+8 ; '2'='follow up' appt. information
+9 ; '3'='non-follow up' appt. information
+10 ;Input: SDIV=division name^division number
+11 ;Input: SDCP=credit pair
+12 ;Input: SC=clinic ifn
+13 ;
+14 if SDOUT
QUIT
+15 IF $GET(SDXM)
DO HDRXM(SDREPORT)
QUIT
+16 IF $EXTRACT(IOST)="C"
IF SDPG
NEW DIR
SET DIR(0)="E"
WRITE !
DO ^DIR
SET SDOUT=Y'=1
if SDOUT
QUIT
+17 NEW SDX,SDI
DO STOP
if SDOUT
QUIT
+18 if SDPG!($EXTRACT(IOST)="C")
WRITE $$XY^SCRPW50(IOF,1,0)
if $X
WRITE $$XY^SCRPW50("",0,0)
+19 WRITE SDLINE,!?(SDIOM-$LENGTH(SDTITL)\2),SDTITL
+20 IF SDREPORT=1
IF 'SDPAST
SET SDX="Clinic availability data"
+21 IF SDREPORT=1
IF SDPAST
SET SDX="Clinic availability and 'next available' appointment data"
+22 IF SDREPORT=2
SET SDX="'Follow up' appointment data"
+23 IF SDREPORT=3
SET SDX="'Non-follow up' appointment data"
+24 IF SDREPORT=4
SET SDX="Listing of patient appointments"
+25 IF SDREPORT=5
SET SDX="Listing of appointments for selected patient"
+26 WRITE !?(SDIOM-$LENGTH(SDX)\2),SDX
+27 DO HDRX(SDTY)
if SDOUT
QUIT
SET SDI=0
+28 IF $GET(SDREPORT)'=5
FOR
SET SDI=$ORDER(SDTIT(SDI))
if 'SDI
QUIT
WRITE !?(SDIOM-$LENGTH(SDTIT(SDI))\2),SDTIT(SDI)
+29 IF $GET(SDREPORT)=5
if '$ORDER(SDTIT(""))
QUIT
Begin DoDot:1
+30 NEW SD
FOR SD=1,2
WRITE !?(SDIOM-$LENGTH(SDTIT(SD))\2),SDTIT(SD)
+31 WRITE !,SDTIT(3),?100,SDTIT(4),!,SDTIT(5),?100,SDTIT(6)
End DoDot:1
+32 WRITE !,SDLINE
+33 WRITE !,"For clinic availability dates ",SDPBDT," through ",SDPEDT
+34 WRITE !,"Date printed: ",SDPNOW,?(IOM-6-$LENGTH(SDPAGE)),"Page: ",SDPAGE
+35 WRITE !,SDLINE
+36 SET SDPAGE=SDPAGE+1
SET SDPG=1
if SDTY
DO SUBT(SDTY,SDREPORT)
QUIT
+37 ;
HDRX(SDTY) ;Extra header lines
+1 KILL SDTIT
+2 if SDTY=0
QUIT
SET SDIV=$GET(SDIV)
+3 IF SDTY=3
SET SDTIT(1)="Facility Summary"
QUIT
+4 NEW SDDV
SET SDDV=$PIECE(SDIV,U)_" ("_$PIECE(SDIV,U,2)_")"
+5 IF SDTY=2
SET SDTIT(1)="Summary for division: "_SDDV
QUIT
+6 SET SDTIT(1)="Division: "_SDDV
+7 if SDSORT="CP"
SET SDTIT(2)="For clinics with credit pair: "_$$OTX^SCRPW73("CP")
+8 IF $GET(SDREPORT)=5
Begin DoDot:1
+9 if SDSORT="CP"
SET SDTIT(2)="For clinics with selected credit pair"
+10 if SDSORT="CA"
SET SDTIT(2)="For all clinics"
+11 if SDSORT="CL"
SET SDTIT(2)="For clinics selected by name"
+12 NEW DA,DIC,DIQ,DR
+13 SET DIC=2
SET SDPT=DIC
SET DA=$GET(DFN)
FOR DR=.01,.09
NEW SDPT,SDARR
SET DIQ="SDARR("
SET DIQ(0)="I"
DO EN^DIQ1
Begin DoDot:2
+14 IF DR=.01
SET SDTIT(3)="Patient: "_SDARR(2,DA,.01,"I")
+15 IF DR=.09
SET SDTIT(4)="SSN: "_SDARR(2,DA,.09,"I")
End DoDot:2
+16 SET SDTIT(5)="Clinic: "_$PIECE(^SC(SC,0),U)
+17 SET SDTIT(6)="Clinic Stop Code Pair: "_SDCP
End DoDot:1
+18 IF '$TEST
SET SDTIT(3)="Detail for clinic: "_$$OTX^SCRPW73("CL")
+19 QUIT
+20 ;
SUBT(SDTY,SDREPORT) ;Print subtitles
+1 if SDREPORT=1
DO SUBT1
if SDREPORT=2
DO SUBT2
+2 if SDREPORT=3
DO SUBT3
if SDREPORT=4
DO SUBT4
+3 if SDREPORT=5
DO SUBT5
+4 QUIT
+5 ;
SUBT1 NEW SDI
+1 WRITE !?(SDCOL+44),"Ava.",?(SDCOL+51),"Pct."
+2 IF SDPAST
Begin DoDot:1
+3 FOR SDI=0:1:3
WRITE ?(SDCOL+63+(14*SDI)),"--Type '",SDI,"'---"
+4 WRITE ?120,"% NNA % NA"
QUIT
End DoDot:1
+5 WRITE !
if SDTY>1
WRITE ?(SDCOL),"Credit Pair"
+6 WRITE ?(SDCOL+35),"Clinic",?(SDCOL+43),"Appt.",?(SDCOL+50),"Slots"
+7 IF SDPAST
Begin DoDot:1
+8 WRITE ?(SDCOL+56),"Clinic"
+9 FOR SDI=0:1:3
WRITE ?(SDCOL+65+(14*SDI)),"Sch. Wait"
+10 WRITE ?122,"<31 <31"
QUIT
End DoDot:1
+11 WRITE !?(SDCOL+4),$SELECT(SDTY=1:"Availability Date",1:"Clinic Name")
+12 WRITE ?(SDCOL+33),"Capacity",?(SDCOL+43),"Slots",?(SDCOL+51),"Ava."
+13 IF SDPAST
Begin DoDot:1
+14 WRITE ?(SDCOL+58),"Enc."
+15 FOR SDI=0:1:3
WRITE ?(SDCOL+64+(14*SDI)),"Appts Time"
+16 WRITE ?121,"Days Days"
End DoDot:1
+17 WRITE !?(SDCOL),$EXTRACT(SDLINE,1,($SELECT(SDPAST:132,1:58)))
+18 QUIT
+19 ;
SUBT2 NEW SDI
+1 WRITE !?48,"Next",?54,$EXTRACT(SDLINE,1,24),"Non-next Available Appointments",$EXTRACT(SDLINE,1,23)
+2 WRITE !?40,"Next Ava. 0-1 0-1 2-7 2-7 8-30 8-30 31-60 31-60 >60 >60"
+3 WRITE !
if SDTY>1
WRITE "Credit Pair"
WRITE ?40,"Ava. Wait"
+4 FOR SDI=56:16:121
WRITE ?(SDI),"Days Wait"
+5 WRITE !?4,$SELECT(SDTY=1:"Availability Date",1:"Clinic Name")
+6 FOR SDI=39:16:120
WRITE ?(SDI),"Appts Time"
+7 WRITE !,SDLINE
+8 QUIT
+9 ;
SUBT3 NEW SDI
+1 WRITE !?38,"Next",?43,$EXTRACT(SDLINE,1,29),"Non-next Available Appointments",$EXTRACT(SDLINE,1,29)
+2 WRITE !?32,"Next Ava. 0-1 0-1 0-1 2-7 2-7 2-7 8-30 8-30 8-30 31-60 31-60 31-60 >60 >60 >60"
+3 WRITE !
if SDTY>1
WRITE "Credit Pair"
WRITE ?32,"Ava. Wait"
+4 FOR SDI=44:18:117
WRITE ?(SDI),"Days Wait Wait"
+5 WRITE !?4,$SELECT(SDTY=1:"Availability Date",1:"Clinic Name"),?31,"Appts Time1"
+6 FOR SDI=43:18:116
WRITE ?(SDI),"Appts Time1 Time2"
+7 WRITE !,SDLINE
+8 QUIT
+9 ;
SUBT4 WRITE !?96,"Next",!,"Date",?96,"Ava. Date Wait Wait"
+1 WRITE !,"Scheduled Patient Name SSN Appointment Date Scheduling Request Type Ind. Desired F/U Time1 Time2"
+2 WRITE !,SDLINE
+3 QUIT
+4 ;
SUBT5 WRITE !?11,"SCHEDULING",?63,"TIME",!,"DATE",?11,"REQUEST",?31,"DATE",?58,"WAIT",?63,"TO",?68,"APPT",?96,"APPT",?102,"COMPLETION"
+1 WRITE !,"SCHEDULED",?11,"TYPE",?31,"DESIRED",?42,"APPT DATE/TIME",?58,"TIME",?63,"APPT",?68,"TYPE",?73,"F/U",?79,"REBOOK DATE",?96,"STAT",?102,"DATE",?113,"SCHEDULER"
+2 WRITE !,SDLINE
+3 QUIT
HDRXM(SDREPORT) ;Create header in mail message
+1 ;Input: SDREPORT=report element to print
+2 ;
+3 NEW SDX,SDI,SDZ
+4 IF SDPAGE>1
FOR SDI=1:1:5
DO XMTX("")
+5 DO XMTX($EXTRACT(SDLINE,1,$SELECT('SDPAST:79,1:132)))
+6 SET SDZ=""
SET $EXTRACT(SDZ,($SELECT(SDPAST:132,1:79)-$LENGTH(SDTITL)\2))=SDTITL
DO XMTX(SDZ)
+7 IF SDREPORT=1
IF 'SDPAST
SET SDX="Clinic availability data"
+8 IF SDREPORT=1
IF SDPAST
SET SDX="Clinic availability and 'next available' appointment data"
+9 IF SDREPORT=2
SET SDX="'Follow up' appointment data"
+10 IF SDREPORT=3
SET SDX="'Non-follow up' appointment data"
+11 IF SDREPORT=4
SET SDX="Listing of patient appointments"
+12 IF SDREPORT=5
SET SDX="Listing of appointments for selected patient"
+13 SET SDZ=""
SET $EXTRACT(SDZ,($SELECT(SDPAST:132,1:79)-$LENGTH(SDX)\2))=SDX
DO XMTX(SDZ)
+14 DO HDRX(SDTY)
SET SDI=0
+15 FOR
SET SDI=$ORDER(SDTIT(SDI))
if 'SDI
QUIT
SET SDZ=""
Begin DoDot:1
+16 SET $EXTRACT(SDZ,($SELECT(SDPAST:130,1:79)-$LENGTH(SDTIT(SDI))\2))=SDTIT(SDI)
DO XMTX(SDZ)
+17 QUIT
End DoDot:1
+18 DO XMTX($EXTRACT(SDLINE,1,$SELECT('SDPAST:79,1:132)))
+19 DO XMTX("For clinic availability dates "_SDPBDT_" through "_SDPEDT)
+20 SET SDZ="Date extracted: "_SDPNOW
+21 DO XMTX(SDZ)
DO XMTX($EXTRACT(SDLINE,1,$SELECT('SDPAST:79,1:132)))
+22 SET SDPAGE=SDPAGE+1
if SDTY
DO SUBTXM(SDTY,SDREPORT)
QUIT
+23 ;
SUBTXM(SDTY,SDREPORT) ;Create message header subtitles
+1 NEW SDZ
+2 if SDREPORT=1
DO STXM1
if SDREPORT=2
DO STXM2
+3 if SDREPORT=3
DO STXM3
if SDREPORT=4
DO STXM4
+4 QUIT
+5 ;
STXM1 NEW SDI
+1 SET SDZ=""
SET $EXTRACT(SDZ,45)="Ava."
SET $EXTRACT(SDZ,52)="Pct."
+2 IF SDPAST
Begin DoDot:1
+3 FOR SDI=0:1:3
Begin DoDot:2
+4 SET $EXTRACT(SDZ,(SDCOL+64+(14*SDI)))="--Type '"_SDI_"'---"
+5 QUIT
End DoDot:2
+6 SET $EXTRACT(SDZ,121)="% NNA % NA"
+7 QUIT
End DoDot:1
+8 DO XMTX(SDZ)
+9 SET SDZ=""
IF SDTY>1
SET SDZ="Credit Pair"
+10 SET $EXTRACT(SDZ,36)="Clinic"
SET $EXTRACT(SDZ,44)="Appt."
SET $EXTRACT(SDZ,51)="Slots"
+11 IF SDPAST
Begin DoDot:1
+12 SET $EXTRACT(SDZ,57)="Clinic"
+13 FOR SDI=0:1:3
SET $EXTRACT(SDZ,(SDCOL+66+(14*SDI)))="Sch. Wait"
+14 SET $EXTRACT(SDZ,123)="<31 <31"
+15 QUIT
End DoDot:1
+16 DO XMTX(SDZ)
+17 SET SDZ=""
SET $EXTRACT(SDZ,4)=$SELECT(SDTY=1:"Availability Date",1:"Clinic Name")
+18 SET $EXTRACT(SDZ,34)="Capacity"
SET $EXTRACT(SDZ,44)="Slots"
SET $EXTRACT(SDZ,52)="Ava."
+19 IF SDPAST
Begin DoDot:1
+20 SET $EXTRACT(SDZ,59)="Enc."
+21 FOR SDI=0:1:3
SET $EXTRACT(SDZ,(SDCOL+65+(14*SDI)))="Appts Time"
+22 SET $EXTRACT(SDZ,122)="Days Days"
+23 QUIT
End DoDot:1
+24 DO XMTX(SDZ)
+25 SET SDZ=""
SET $EXTRACT(SDZ,$SELECT(SDTY>1:1,1:4))=$EXTRACT(SDLINE,1,$SELECT(SDPAST:132,1:58))
+26 DO XMTX(SDZ)
+27 QUIT
+28 ;
STXM2 NEW SDI
SET SDZ=""
+1 SET $EXTRACT(SDZ,49)="Next"
+2 SET $EXTRACT(SDZ,55)=$EXTRACT(SDLINE,1,24)_"Non-next Available Appointments"_$EXTRACT(SDLINE,1,23)
+3 DO XMTX(SDZ)
SET SDZ=""
+4 SET $EXTRACT(SDZ,41)="Next Ava. 0-1 0-1 2-7 2-7 8-30 8-30 31-60 31-60 >60 >60"
+5 DO XMTX(SDZ)
SET SDZ=""
+6 if SDTY>1
SET SDZ="Credit Pair"
SET $EXTRACT(SDZ,41)="Ava. Wait"
+7 FOR SDI=57:16:121
SET $EXTRACT(SDZ,SDI)="Days Wait"
+8 DO XMTX(SDZ)
SET SDZ=""
+9 SET $EXTRACT(SDZ,4)=$SELECT(SDTY=1:"Availability Date",1:"Clinic Name")
+10 FOR SDI=40:16:120
SET $EXTRACT(SDZ,SDI)="Appts Time"
+11 DO XMTX(SDZ)
SET SDZ=""
+12 SET SDZ=SDLINE
DO XMTX(SDZ)
+13 QUIT
+14 ;
STXM3 NEW SDI
SET SDZ=""
+1 SET $EXTRACT(SDZ,39)="Next"
+2 SET $EXTRACT(SDZ,44)=$EXTRACT(SDLINE,1,29)_"Non-next Available Appointments"_$EXTRACT(SDLINE,1,29)
+3 DO XMTX(SDZ)
SET SDZ=""
+4 SET $EXTRACT(SDZ,33)="Next Ava. 0-1 0-1 0-1 2-7 2-7 2-7 8-30 8-30 8-30 31-60 31-60 31-60 >60 >60 >60"
+5 DO XMTX(SDZ)
SET SDZ=""
+6 if SDTY>1
SET SDZ="Credit Pair"
SET $EXTRACT(SDZ,33)="Ava. Wait"
+7 FOR SDI=45:18:117
SET $EXTRACT(SDZ,SDI)="Days Wait Wait"
+8 DO XMTX(SDZ)
SET SDZ=""
+9 SET $EXTRACT(SDZ,4)=$SELECT(SDTY=1:"Availability Date",1:"Clinic Name")
SET $EXTRACT(SDZ,32)="Appts Time1"
+10 FOR SDI=44:18:116
SET $EXTRACT(SDZ,SDI)="Appts Time1 Time2"
+11 DO XMTX(SDZ)
SET SDZ=""
+12 SET SDZ=SDLINE
DO XMTX(SDZ)
+13 QUIT
+14 ;
STXM4 SET SDZ=""
+1 SET $EXTRACT(SDZ,96)="Next"
+2 DO XMTX(SDZ)
SET SDZ=""
+3 SET SDZ="Date"
SET $EXTRACT(SDZ,96)="Ava. Date Wait Wait"
+4 DO XMTX(SDZ)
SET SDZ=""
+5 SET SDZ="Scheduled Patient Name SSN Appointment Date Scheduling Request Type Ind. Desired F/U Time1 Time2"
+6 DO XMTX(SDZ)
SET SDZ=""
+7 SET SDZ=SDLINE
DO XMTX(SDZ)
+8 QUIT
+9 ;
STOP ;Check for stop task request
+1 if $DATA(ZTQUEUED)
SET (SDOUT,ZTSTOP)=$SELECT($$S^%ZTLOAD:1,1:0)
QUIT
+2 ;
XMTX(SDX) ;Set mail message text line
+1 ;Input: SDX=text value
+2 SET ^TMP("SDXM",$JOB,SDXM)=SDX
SET SDXM=SDXM+1
QUIT
