Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCRPW76

SCRPW76.m

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