source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCRPW74.m@ 1789

Last change on this file since 1789 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.1 KB
Line 
1SCRPW74 ;BP-CIOFO/KEITH,ESW - Clinic appointment availability extract (cont.) ; 6/10/03 9:13am
2 ;;5.3;Scheduling;**192,206,223,241,249,291**;AUG 13, 1993
3 ;
4MON(SDEX,SDT,SDMON) ;Determine month and date ranges for extracts
5 ;Input: SDEX=extract type, '1' for prospective, '2' for retrospective
6 ;Input: SDT=date of extract run
7 ;Input: SDMON=array to return date information (pass by reference)
8 ;Output: month/year of extract^begin date of report data
9 ;Output: SDMON array as follows:
10 ; SDMON("SDBDT")=begin date
11 ; SDMON("SDDIV")=0
12 ; SDMON("SDEDT")=end date
13 ; SDMON("SDEX")=extract type ('1' or '2')
14 ; SDMON("SDPAST")='1' for extract 2, '0' otherwise
15 ; SDMON("SDPBDT")=begin date external value
16 ; SDMON("SDPEDT")=end date external value
17 ; SDMON("SDRPT")=month/year of extract^begin date of data
18 ;
19 N SDPAR,Y,SDX,SDY,X1,X2
20 S SDMON("SDDIV")=0,SDMON("SDPAST")=$S(SDEX=1:0,1:1)
21 S SDMON("SDEX")=SDEX,SDPAR=$G(^SD(404.91,1,"PATCH192"))
22 I SDEX=1 D
23 .S Y=$S($E(SDT,4,5)=12:$E(SDT,1,3)+1_"0101",1:$E(SDT,1,5)+1_"01")
24 .S SDMON("SDBDT")=Y X ^DD("DD") S SDMON("SDPBDT")=Y
25 .S X1=SDMON("SDBDT"),X2=$P(SDPAR,U,2) S:X2<1 X2=180 S X2=X2-1
26 .D C^%DTC S (SDMON("SDEDT"),Y)=X X ^DD("DD") S SDMON("SDPEDT")=Y
27 .Q
28 I SDEX=2 D
29 .S Y=$S($E(SDT,4,5)="01":$E(SDT,1,3)-1_1201,1:$E(SDT,1,5)-1_"01")
30 .S SDMON("SDBDT")=Y X ^DD("DD") S SDMON("SDPBDT")=Y
31 .S X1=SDMON("SDBDT"),X2=$P(SDPAR,U,4) S:X2<1 X2=31 S X2=X2-1
32 .D C^%DTC I $E(X,1,5)>$E(SDMON("SDBDT"),1,5) D
33 ..S X1=$E(X,1,5)_"01",X2=-1 D C^%DTC Q
34 .S (SDMON("SDEDT"),Y)=X X ^DD("DD") S SDMON("SDPEDT")=Y
35 .Q
36 S SDY=SDMON("SDBDT")
37 S:SDEX=2 SDY=$S($E(SDY,4,5)=12:$E(SDY,1,3)+1_"0101",1:$E(SDY,1,5)+1_"01") S SDX=+$E(SDY,4,5)
38 S SDX=$P("JANUARY^FEBRUARY^MARCH^APRIL^MAY^JUNE^JULY^AUGUST^SEPTEMBER^OCTOBER^NOVEMBER^DECEMBER",U,SDX)
39 S SDX=SDX_" "_(17+$E(SDY)_$E(SDY,2,3))_U_SDMON("SDBDT")
40 S SDMON("SDRPT")=SDX
41 Q SDX
42 ;
43QDIS(SDXTMP) ;Display extract queuing information
44 ;Input: SDXTMP=array of data from ^XTMP("SD53P192")
45 N SDEX,Y
46 W !!?18,"*** Extract queuing information on file ***"
47 I '$D(SDXTMP) W !!,"==> No extract queuing data found" Q
48 F SDEX=1,2 D
49 .W !!?22,"Extract ",SDEX," report: ",$P($G(SDXTMP("EXTRACT",SDEX,"REPORT")),U)
50 .W !?24,"Extract ",SDEX," task: ",$G(SDXTMP("EXTRACT",SDEX,"TASK"))
51 .S Y=$G(SDXTMP("EXTRACT",SDEX,"DATE")) I Y X ^DD("DD")
52 .W !?20,"Extract ",SDEX," run date: ",Y
53 .Q
54 Q
55 ;
56DAYS(SDATE,SDAY) ;Adjust target day if necessary
57 ;Input: SDATE=date
58 ;Input: SDAY=target day
59 ;Output: target SDAY for the month of SDATE, adjusted if necessary
60 N SDX,X,X1,X2
61 S X1=$S($E(SDATE,4,5)=12:($E(SDATE,1,3)+1)_"01",1:$E(SDATE,1,5)+1)_"01"
62 S X2=-1 D C^%DTC S SDX=$E(X,6,7)
63 Q $S(SDX<SDAY:SDX,1:SDAY)
64 ;
65WHEN(SDEX,SDNOW) ;Determine date for next run
66 ;Input: SDEX=extract type
67 ;Input: SDDT=date/time to calculate from (optional)
68 ;Output: if success, date/time for next run
69 ; if already scheduled, -1^date_scheduled^task_number
70 N SDPAR,SDAY,X1,X2,X,SDTIME,SDINT,SDT,SDDT
71 S SDNOW=$G(SDNOW) I SDNOW<1 S SDNOW=$$NOW^XLFDT()
72 S SDDT=$P(SDNOW,".")
73 ;
74 ;Quit if already scheduled
75 Q:$G(^XTMP("SD53P192","EXTRACT",SDEX,"DATE"))>SDNOW "-1^"_^XTMP("SD53P192","EXTRACT",SDEX,"DATE")_U_$G(^XTMP("SD53P192","EXTRACT",SDEX,"TASK"))
76 ;
77 S SDPAR=$G(^SD(404.91,1,"PATCH192")),SDAY=$P(SDPAR,U) S:'SDAY SDAY=31
78 S SDINT=$P(SDPAR,U,5) I SDINT=""!("MQSA"'[SDINT) S SDINT="M"
79 S SDTIME=$P(SDPAR,U,6) I 'SDTIME!(SDTIME>.2359) S SDTIME=.22
80 S X1=$E(SDDT,1,5)_"01",X2=$$DAYS(SDDT,SDAY)-1 D C^%DTC
81 I (X+SDTIME)<SDNOW D
82 .S X1=$S($E(X,4,5)=12:($E(X,1,3)+1)_"01",1:$E(X,1,5)+1)_"01"
83 .S X2=$$DAYS(X1,SDAY)-1 D C^%DTC
84 .Q
85 ;
86 ;Values for monthly queuing
87 I SDINT="M" Q:SDEX=1 X+SDTIME Q $$WHEN2(X)
88 ;
89 ;Values for quarterly queuing
90 I SDINT="Q" D Q X
91 .S X1=+$E(X,4,5),X1=$S(X1<4:"03",X1<7:"06",X1<10:"09",1:12)
92 .S X1=$E(X,1,3)_X1_"01",X2=$$DAYS(X1,SDAY)-1 D C^%DTC
93 .I SDEX=1 S X=X+SDTIME Q
94 .S X=$$WHEN2(X) Q
95 ;
96 ;Values for semi-annual queuing
97 I SDINT="S" D Q X
98 .S X1=+$E(X,4,5) S:X1>9 X=$E(X,1,3)+1_$E(X,4,7)
99 .S X1=$S(X1<4:"03",X1<10:"09",1:"03")
100 .S X1=$E(X,1,3)_X1_"01",X2=$$DAYS(X1,SDAY)-1 D C^%DTC
101 .I SDEX=1 S X=X+SDTIME Q
102 .S X=$$WHEN2(X) Q
103 ;
104 ;Values for annual queuing
105 S X1=+$E(X,4,5) S:X1>9 X=$E(X,1,3)+1_$E(X,4,7)
106 S X=$E(X,1,3)_"0901",X2=$$DAYS(X1,SDAY)-1 D C^%DTC
107 Q:SDEX=1 X+SDTIME Q $$WHEN2(X)
108 ;
109WHEN2(X) ;Determine date for extract 2
110 ;Input: X=date for extract 1
111 ;Output: date/time for extract 2
112 S SDT=$S($E(X,4,5)=12:$E(X,1,3)+1_"0101",1:$E(X,1,5)+1_"01")
113 S SDAY=$P(SDPAR,U,3) S:'SDAY!SDAY>31 SDAY=5
114 S X1=SDT,X2=$$DAYS(SDT,SDAY)-1 D C^%DTC
115 S X=X+SDTIME Q X
116 ;
117SCHED(SDEX,SDT,SDRPT,SDMON,SDKID) ;Schedule repetitive extract run
118 ;Input: SDEX=extract type
119 ;Input: SDT=date/time to queue extract
120 ;Input: SDRPT=month/year of report^begin date of report data
121 ;Input: SDMON=report parameters from MON^SCRPW74 (pass by reference)
122 ;Input: SDKID='1' if from KIDS install (optional)
123 N SDI,Y,ZTSK,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSAVE
124 S ZTDTH=SDT,ZTSAVE("SDMON(")="",ZTRTN="RUN^SCRPW74(1)",ZTIO=""
125 S ZTDESC="Clinic Appointment Wait Time Extract ("_SDMON("SDEX")_")"
126 F SDI=1:1:20 D ^%ZTLOAD Q:$G(ZTSK)
127 ;
128QQ I '$G(ZTSK) D Q
129 .I $G(SDKID) D BMES^XPDUTL("Extract not queued!!!") Q
130 .W !!,"Extract not queued!!!",! Q
131 S Y=SDT X ^DD("DD")
132 I $G(SDKID) D BMES^XPDUTL("Extract "_SDEX_" queued for "_Y_", task number: "_ZTSK)
133 I '$G(SDKID) W !!,"Extract "_SDEX_" queued for "_Y_", task number: "_ZTSK,!
134 ;
135XTMP ;Service ^XTMP nodes
136 N X1,X2,X
137 S X1=$P($P(SDT,U),"."),X2=45 D C^%DTC S SDPGDT=X
138 I '$D(^XTMP("SD53P192",0)) D
139 .S ^XTMP("SD53P192",0)=SDPGDT_"^Patch SD*5.3*192 'Clinic Wait Time' extract repetitive queuing information. Created by user: "_DUZ
140 .Q
141 S:$P(^XTMP("SD53P192",0),U)<SDPGDT $P(^XTMP("SD53P192",0),U)=SDPGDT
142 S ^XTMP("SD53P192","EXTRACT",SDEX,"TASK")=ZTSK
143 S ^XTMP("SD53P192","EXTRACT",SDEX,"DATE")=SDT
144 S ^XTMP("SD53P192","EXTRACT",SDEX,"REPORT")=SDRPT
145 Q
146 ;
147RUN(SDR) ;Run extract (reschedule if requested)
148 ;Input: SDR='1' if rescheduling is requested, '0' otherwise.
149 N SDV,SDBDT,SDDIV,SDEDT,SDEX,SDPAST,SDPBDT,SDPEDT,SDRPT
150 S SDV="" F S SDV=$O(SDMON(SDV)) Q:SDV="" S @SDV=SDMON(SDV)
151 I SDR=1 D
152 .I $G(^XTMP("SD53P192","EXTRACT",SDEX,"TASK"))=ZTSK K ^XTMP("SD53P192","EXTRACT",SDEX)
153 .N SDT,SDMON
154 .S SDT=$P(SDRPT,U,2)
155 .S:SDEX=2 SDT=$S($E(SDT,4,5)=12:$E(SDT,1,3)+1_"0101",1:$E(SDT,1,5)+1_"01")
156 .S SDT=$$WHEN(SDEX),SDRPT=$$MON(SDEX,SDT,.SDMON)
157 .D SCHED(SDEX,SDT,SDRPT,.SDMON)
158 .Q
159 D EXTRACT^SCRPW72
160 ;
161EXIT I $E(IOST)="C",'$G(SDOUT),'$G(SDXM) N DIR S DIR(0)="E" D ^DIR
162 F SDI="SD","SDS","SDTMP","SDTOT","SDXM","SDNAVA","SDNAVB","SDIP","SDPAT","SDORD","SDIPLST" K ^TMP(SDI,$J)
163 K ^TMP("SDPAT",+$G(SDJN))
164 K %,%DT,%H,%I,%T,%Y,CT,D,DA,DAY,DIC,DIE,DIR,DR,DTOUT,DUOUT,ENDATE
165 K I,J,MAX,MAXDT,SC,SC0,SCNA,SD,SDAY,SDBDT,SDBEG,SDC,SDFLEN,SDREPORT
166 K SDCAP,SDCCP,SDCNAM,SDCOL,SDCP,SDCT,SDDAY,SDDIV,SDDT,SDDV,SDDW
167 K SDEDT,SDEND,SDEX,SDEXDT,SDFAC,SDFMT,SDHD,SDI,SDIN,SDINT,SDIV
168 K SDKID,SDL,SDLINE,SDMAX,SDMD,SDMG,SDMON,SDMPDT,SDNOW,SDOE,SDOE0
169 K SDOUT,SDP,SDPAGE,SDPAR,SDPAST,SDPATT,SDPBDT,SDPCT,SDPEDT,SDPG
170 K SDPGDT,SDPNOW,SDQUIT,SDR,SDRE,SDRPT,SDS,SDSC1,SDSC2,SDSIZE,SDSL
171 K SDSOH,SDSORT,SDSSC,SDSTRTDT,SDT,SDTCAP,SDTIME,SDTIT,SDTITL,SDTOE
172 K SDTSL,SDTX,SDTY,SDV,SDX,SDXM,SDXTMP,SDY,SDZ,SI,SM,SS,X,X1,X2,Y
173 K SDJN,SDFMT,SDFMTS
174 D:$D(IOM) END^SCRPW50 Q
Note: See TracBrowser for help on using the repository browser.