230 lines
8.6 KiB
Mathematica
230 lines
8.6 KiB
Mathematica
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
|