source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDOQMP.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1SDOQMP ;ALB/SCK - Appointment Monitoring / Performance Measure report ; [07/17/96]
2 ;;5.3;SCHEDULING;**47**;AUG 13,1993
3 Q
4 ;
5EN ; Entry point for Access PM extract to be sent to data collection server
6 ;
7 Q:$$CHKTASK^SDOQMP0
8 D INIT,LOOP,START^SDOQMP2,BLDPME
9 D END^SDOQMP1
10 Q
11 ;
12EN1 ; Entry point for interactive appointment monitoring report
13 ;
14 N XT,XT1,CONT,PMSEL
15 ;
16 S PMSEL=$$SELECT^SDOQMP0
17 Q:PMSEL']""
18 ;
19 I PMSEL="C" G EN1Q:'$$CLINIC^SDOQMP0
20 I PMSEL="S" G EN1Q:'$$STOP^SDOQMP0
21 I PMSEL="D" G EN1Q:'$$DIV^SDOQMP0
22 ;
23 F XT=1:1 S XT1=$P($T(MSG+XT),";;",2) Q:XT1="$$END" W !,XT1
24AGN S CONT=0
25 S %ZIS="Q" D ^%ZIS G:POP EN1Q
26 ;
27 I IOM'=132 D G:'CONT AGN
28 . S:$E(IOST,1,2)="C-" DIR("A",1)="It's not recommended to print this report to screen."
29 . S DIR(0)="Y^A",DIR("A")="Do you want to select another device?",DIR("B")="YES"
30 . S DIR("A",2)="The selected device does not have 132 columns."
31 . D ^DIR K DIR
32 . S:$D(DIRUT)!(Y=0) CONT=1
33 ;
34QUE I $D(IO("Q")) D G EN1Q
35 . S ZTRTN="START^SDOQMP",ZTDESC="Appointment Monitoring Report"
36 . S:PMSEL="C" ZTSAVE("CLINIC(")="",ZTSAVE("CLINIC")=""
37 . S:PMSEL="S" ZTSAVE("VAUTC(")="",ZTSAVE("VAUTC")=""
38 . S:PMSEL="D" ZTSAVE("VAUTD(")="",ZTSAVE("VAUTD")=""
39 . D ^%ZTLOAD W:$D(ZTSK) !,"TASK #: ",ZTSK
40 . D HOME^%ZIS K IO("Q")
41 ;
42 D WAIT^DICD
43START D INIT,LOOPS^SDOQMP0,START^SDOQMP2,BLDRPT
44 ;
45EN1Q D:'$D(ZTQUEUED) ^%ZISC
46 D END^SDOQMP1
47 K CLINIC,^TMP("SDAMMS"),^TMP("SDPM"),VAUTD,VAUTC,^TMP("SDMSG")
48 Q
49 ;
50INIT ; Initialize date arrays for calculating next available appointments
51 ;
52 S:'$D(U) U="^"
53 K ^TMP("SDAMMS"),^TMP("SDPM"),^TMP("APPT")
54 S ^TMP("SDAMMS",$J,"MGN")=80,(CNT,CNT1,CNT2,CNT3,CNT4)=0,IOM=80
55 S ^TMP("SDAMMS",$J,"PG")=0,$P(^TMP("SDAMMS",$J,"="),"=",IOM)=""
56 S X="T" D ^%DT S DT=Y X ^DD("DD") S ^TMP("SDAMMS",$J,"DT")=Y
57 S X="T" D ^%DT S AMMSRDT=Y
58 S ^TMP("SDPM",$J,0)=DT
59 S AMMSCNT="",AMMSLAST=0,AMMSZDT=DT,AMMSFDT=20,AMMSFSL=33
60 D DATES^SDOQMP1
61 Q
62 ;
63LOOP ; Loop through the clinics in the Hospital location file. Use only those clinics with
64 ; an associated stop code on the required list for the access performance measure
65 ;
66 ; Variables
67 ; AMMSD0 - Clinic IEN
68 ;
69 S AMMSD0=0
70 F S AMMSD0=$O(^SC("AC","C",AMMSD0)) Q:'AMMSD0 D
71 . Q:'$P($G(^SC(AMMSD0,0)),"^",7)
72 . Q:'$$CLNOK^SDOQMP0($P($G(^SC(AMMSD0,0)),"^",7))
73 . Q:$G(^TMP("SDAMMS",$J,"Q"))=1
74 . F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
75 Q
76 ;
77LOOPC ; Loop through the clinics in the hospital location file. User can select
78 ; one-many-all clinics through this entry point.
79 ;
80 ; Variables
81 ; AMMSD0 - Clinic IEN
82 ; CLINIC - Clinic array returned from VAUTOMA
83 ;
84 S AMMSD0=0
85 ; Select all
86 I CLINIC=1 D
87 . F S AMMSD0=$O(^SC("AC","C",AMMSD0)) Q:'AMMSD0 D
88 .. Q:'$P($G(^SC(AMMSD0,0)),"^",7)
89 .. Q:$G(^TMP("SDAMMS",$J,"Q"))=1
90 .. F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
91 ;
92 ; Select One-Many
93 I CLINIC=0&($D(CLINIC)) D
94 . F S AMMSD0=$O(CLINIC(AMMSD0)) Q:'AMMSD0 D
95 .. Q:'$P($G(^SC(AMMSD0,0)),"^",7)
96 .. Q:$G(^TMP("SDAMMS",$J,"Q"))=1
97 .. F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
98 Q
99 ;
100BLDPME ; Build the data array to be included in the mail message.
101 ; If the number of data lines in the current array goes over 100,
102 ; Send the array and begin building a new one.
103 ;
104 ; Data String format:
105 ; Clinic Name^Date Run^Date of Next Appt.^# of Days^Stop code^Division
106 ;
107 N X,LC,PMNODE,PMDT,PMMSG,PMCLNI,PMCLNE,PMAPT
108 ;
109 K ^TMP("SDMSG")
110 S X=$G(^TMP("SDPM",$J,0)),PMDT=$P(X,U)
111 S LC=1,PMCLNI=0
112 ;
113 F S PMCLNI=$O(^TMP("SDPM",$J,PMCLNI)) Q:'PMCLNI D
114 . S PMNODE=$G(^TMP("SDPM",$J,PMCLNI,PMDT))
115 . S PMCLNE=$P($G(^SC(PMCLNI,0)),U)
116 . S PMAPT=$P(PMNODE,U)
117 . S X2=PMDT,X1=PMAPT D ^%DTC
118 . S ^TMP("SDMSG",$J,LC)=PMCLNE_U_PMDT_U_PMAPT_U_$S(X']"":-1,1:X)_U_$$STOPCDE^SDOQMP0(PMCLNI)_U_$$DIVISION^SDOQMP0(PMCLNI)
119 . S LC=LC+1
120 ;
121 D:LC>350 PRCLRG
122 I LC'>350 D PRCSML
123DMQ Q
124 ;
125PRCSML ; Process clinic lists smaller than 500 entries
126 N PMMSG,LC
127 S (X,LC)=0
128 F S X=$O(^TMP("SDMSG",$J,X)) Q:'X D
129 . S LC=LC+1
130 . S PMMSG(LC)=^TMP("SDMSG",$J,X)
131 D MAIL(.PMMSG,LC)
132 Q
133 ;
134PRCLRG ; Process clinic lists greater than 500 entries
135 N SDTMP,XF,XL,XC
136 S XF=1,XL=350
137 ;
138LP1 F XC=XF:1:XL Q:XC'<LC D
139 . S SDTMP(XC)=^TMP("SDMSG",$J,XC)
140 ;
141 D MAIL(.SDTMP,LC,XC)
142 ;
143 S XF=XL+1,XL=XL+350
144 K SDTMP
145 G:XC<LC LP1
146 Q
147 ;
148MAIL(PMDATA,LINCNT,CNT) ; Send data message to server.
149 ; The data message is sent to the local notification mail group,
150 ; the notification mail group at the server domain, and the
151 ; server at the data collection server domain
152 ;
153 ; Server
154 ; A1BO PM NEXT APPT EXTRACT at Albany ISC
155 ;
156 ; Variables
157 ; MSG - Data array to be sent
158 ; LINCNT - Number of lines in the data array
159 ;
160 ; Message Format
161 ; Header - $START^Site Name^Facility Number^Date.Time run^Domain Name^Total lines^Last line sent
162 ; Body - data array (see BLDPME)
163 ; Tail - $END
164 ;
165 N XC,X1,%DT,XMB,PMFAC,XMLOC
166 ;
167 S XMLOC=0
168 S XMDUZ=.5
169 S XMY(".5")=""
170 S XMY("S.A1BO PM NEXT APPT EXTRACT@DEVFEX.ISC-ALBANY.VA.GOV")=""
171 S XMY("G.SD PM NOTIFICATION")=""
172 S XMY("G.SD PM EXTRACT@ISC-ALBANY.VA.GOV")=""
173 ;
174 S PMFAC=$$SITE^VASITE
175 D NOW^%DTC
176 ;
177 S PMDATA(.01)="$START^"_$P($G(PMFAC),"^",2,3)_"^"_%_"^"_$G(^XMB("NETNAME"))_"^"_LINCNT_"^"_$G(CNT)
178 S PMDATA(LINCNT+1)="$END"
179 ;
180 S XMTEXT="PMDATA("
181 S XMSUB="Access PM Extract from "_$P($G(PMFAC),U,2),XMN=0
182 D ^XMD
183 K XMDUZ,XMN,XMSUB,XMTEXT,XMY
184SMQ Q
185 ;
186BLDRPT ; Call the entry point to print the Appointment Monitoring report
187 D START^SDOQMPR
188 Q
189 ;
190MSG ; Message displayed to user when the EN1 entry point is used.
191 ;;
192 ;;This report requires 132 columns and could take a long time
193 ;;to print depending on the number of clinics selected.
194 ;;Please remember to QUEUE it.
195 ;;$$END
Note: See TracBrowser for help on using the repository browser.