- 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 Feb 19, 2025@00:10:35 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