source: FOIAVistA/trunk/r/VISUAL_IMPAIRMENT_SERVICE_TEAM-ANRV/ANRVAM1.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 7.9 KB
Line 
1ANRVAM1 ;MUSK/GLD,MFW,HCIOFO/NDH - VIST AMIS CALC ; 11 Apr 89 / 9:20 AM
2 ;;4.0; Visual Impairment Service Team ;**2**;12 Jun 98
3INTRO W @IOF,"I WILL PRINT THE AMIS REPORT FOR PERIOD SPECIFIED.",!!
4 ;ROUTINE TO CALCULATE ALL VIST AMIS DATA IN FILE BY AMIS CODE.
5BDATE S %DT="EXTA",%DT("A")=" BEGINNING AMIS DATE: " D ^%DT Q:Y<0 S ANQBD=Y
6EDATE S %DT("A")=" ENDING AMIS DATE: " D ^%DT Q:Y<0 S ANQED=Y
7 I ANQBD>ANQED D G INTRO
8 .W !!," Beginning Date greater than Ending Date"
9 .R X:5
10ASKMAIL ; Check to see if user wants to email this report
11 W !!!,"Do you want to email the AMIS report to the program office?(Y/N)"
12 D YN^DICN
13 I %=-1 Q
14 I %=0 W !,"Answer Y or N" G ASKMAIL
15 S ANQSEL=%
16 I ANQSEL=2 D DEVICE Q
17 F D Q:ANRVMHE="^"!(ANRVMHE?1.4N!(ANRVMHE?1.4N1"."1.2N))
18 .W !!,"Enter Average Man Hours Expensed by"
19 .W !,"VIST Coordinator Per Week or ^ to exit: "
20 .R ANRVMHE:30
21 .S:'$T ANRVMHE="^"
22 .Q:ANRVMHE="^"
23 .S:+ANRVMHE<1 ANRVMHE=""
24 .I ANRVMHE'?1.4N,ANRVMHE'?1.4N1"."1.2N D
25 ..W !!,"Field 050 - Average Man Hours must be entered"
26 ..W !!,"Must be a number between 1 and 9999.99"
27 ..W !,"Up to 2 decimal precision is allowed."
28 .; Send mail to specified recipients
29 .S ANQMAIL=$$GETADDR()
30 .I ANQMAIL="" D
31 ..W !,"No address is defined in your VIST SITE PARAMATERS"
32 ..W !," for the AMIS report. The AMIS report will not be sent."
33 ..W !," Please enter the appropriate data or contact"
34 ..W !," your system administrator.",!!
35 ..S ANRVMHE="^"
36 D:ANRVMHE'="^" DQ
37 Q
38DEVICE K IOP S %ZIS="MQ",%ZIS("B")="" D ^%ZIS G:POP CLEAN
39 I $D(IO("Q")) D G CLEAN
40 .K IO("Q")
41 .S ZTSAVE("ANQ*")="",ZTDESC="VIST AMIS",ZTRTN="DQ^ANRVAM1"
42 .D ^%ZTLOAD
43 .K ZTSK
44DQ K ANRVBAD F ANQJ=0:1:49 S ^TMP("ANRV",$J,ANQJ)=0
45 D FV^ANRVAM2
46 S ANRVP=""
47 F S ANRVP=$O(^ANRV(2040,"B",ANRVP)) Q:ANRVP="" S ANRVIN="" D LOOP2
48 S ANRBD=(ANQBD-.01) D ^ANRVAM2 G CLOSE
49LOOP2 F S ANRVIN=$O(^ANRV(2040,"B",ANRVP,ANRVIN)) Q:ANRVIN="" D CALC
50 Q
51CALC ;
52 S VAL=""
53 I '$D(^ANRV(2040,ANRVIN,13)) S ANRVBAD(ANRVIN)="",VAL="" Q
54 S VAL=$P(^ANRV(2040,ANRVIN,13),"^",2)
55 I VAL="001" S ^TMP("ANRV",$J,1)=^TMP("ANRV",$J,1)+1 S VAL="" G CALC2
56 I VAL="002" S ^TMP("ANRV",$J,2)=^TMP("ANRV",$J,2)+1 Q
57 I VAL="003" S ^TMP("ANRV",$J,3)=^TMP("ANRV",$J,3)+1 Q
58 Q
59CALC2 S VAL=""
60 I $P(^ANRV(2040,ANRVIN,7),"^",3)'="" S VAL=$P(^ANRV(2040,ANRVIN,7),"^",3)
61 I VAL="004" S ^TMP("ANRV",$J,4)=^TMP("ANRV",$J,4)+1 G CALC3
62 I VAL="005" S ^TMP("ANRV",$J,5)=^TMP("ANRV",$J,5)+1 G CALC3
63 I VAL="006" S ^TMP("ANRV",$J,6)=^TMP("ANRV",$J,6)+1 G CALC3
64 I VAL="007" S ^TMP("ANRV",$J,7)=^TMP("ANRV",$J,7)+1 G CALC3
65 I VAL="008" S ^TMP("ANRV",$J,8)=^TMP("ANRV",$J,8)+1 G CALC3
66CALC3 S VAL=""
67 I $P(^ANRV(2040,ANRVIN,7),"^",4)'="" S VAL="",VAL=$P(^ANRV(2040,ANRVIN,7),"^",4)
68 I VAL="009" S ^TMP("ANRV",$J,9)=^TMP("ANRV",$J,9)+1 G CALC4
69 I VAL="010" S ^TMP("ANRV",$J,10)=^TMP("ANRV",$J,10)+1 G CALC4
70 I VAL="011" S ^TMP("ANRV",$J,11)=^TMP("ANRV",$J,11)+1 G CALC4
71 I VAL="012" S ^TMP("ANRV",$J,12)=^TMP("ANRV",$J,12)+1 G CALC4
72 I VAL="013" S ^TMP("ANRV",$J,13)=^TMP("ANRV",$J,13)+1 G CALC4
73 I VAL="014" S ^TMP("ANRV",$J,14)=^TMP("ANRV",$J,14)+1 G CALC4
74 I VAL="015" S ^TMP("ANRV",$J,15)=^TMP("ANRV",$J,15)+1 G CALC4
75CALC4 S VAL="",DFN=ANRVP
76 D ELIG^VADPT S:$D(VAEL(2)) VAL=$P(VAEL(2),"^")
77 I VAL=2 S ^TMP("ANRV",$J,16)=^TMP("ANRV",$J,16)+1 G CALC5
78 I VAL=4 S ^TMP("ANRV",$J,16)=^TMP("ANRV",$J,16)+1 G CALC5
79 I VAL=3 S ^TMP("ANRV",$J,17)=^TMP("ANRV",$J,17)+1 G CALC5
80 I VAL=1 S ^TMP("ANRV",$J,18)=^TMP("ANRV",$J,18)+1 G CALC5
81 I VAL=7 S ^TMP("ANRV",$J,19)=^TMP("ANRV",$J,19)+1 G CALC5
82 I VAL=6 S ^TMP("ANRV",$J,20)=^TMP("ANRV",$J,20)+1 G CALC5
83 I VAL=8 S ^TMP("ANRV",$J,20)=^TMP("ANRV",$J,20)+1 G CALC5
84 I VAL=9 S ^TMP("ANRV",$J,20)=^TMP("ANRV",$J,20)+1 G CALC5
85 I VAL=5 S ^TMP("ANRV",$J,20)=^TMP("ANRV",$J,20)+1 G CALC5
86 I VAL=121 S ^TMP("ANRV",$J,20)=^TMP("ANRV",$J,20)+1 G CALC5
87 S ^TMP("ANRV",$J,21)=^TMP("ANRV",$J,21)+1 G CALC5
88CALC5 S VAL=""
89 I $D(^ANRV(2040,ANRVIN,5)),$P(^ANRV(2040,ANRVIN,5),"^",1)'="" S VAL="",VAL=$P(^ANRV(2040,ANRVIN,5),"^",1)
90 I VAL="022" S ^TMP("ANRV",$J,22)=^TMP("ANRV",$J,22)+1 G CALC6
91 I VAL="023" S ^TMP("ANRV",$J,23)=^TMP("ANRV",$J,23)+1 G CALC6
92 I VAL="024" S ^TMP("ANRV",$J,24)=^TMP("ANRV",$J,24)+1 G CALC6
93 I VAL="025" S ^TMP("ANRV",$J,25)=^TMP("ANRV",$J,25)+1 G CALC6
94CALC6 S VAL="",VAL=$P(^DPT(ANRVP,0),"^",3) G:VAL="" CALC16
95 S VAL=$E(DT,1,3)-$E(VAL,1,3)-($E(DT,4,7)<$E(VAL,4,7))
96 I VAL<25 S ^TMP("ANRV",$J,26)=^TMP("ANRV",$J,26)+1 Q
97 I VAL<35,VAL>24 S ^TMP("ANRV",$J,27)=^TMP("ANRV",$J,27)+1 Q
98 I VAL<45,VAL>34 S ^TMP("ANRV",$J,28)=^TMP("ANRV",$J,28)+1 Q
99 I VAL<55,VAL>44 S ^TMP("ANRV",$J,29)=^TMP("ANRV",$J,29)+1 Q
100 I VAL<65,VAL>54 S ^TMP("ANRV",$J,30)=^TMP("ANRV",$J,30)+1 Q
101 I VAL<75,VAL>64 S ^TMP("ANRV",$J,31)=^TMP("ANRV",$J,31)+1 Q
102 I VAL<85,VAL>74 S ^TMP("ANRV",$J,32)=^TMP("ANRV",$J,32)+1 Q
103 I VAL>84 S ^TMP("ANRV",$J,33)=^TMP("ANRV",$J,33)+1 Q
104CALC16 S ^TMP("ANRV",$J,34)=^TMP("ANRV",$J,34)+1 Q
105 Q
106CLOSE ; Check if user wanted to send mail to DC
107 ; and complete report.
108 ;
109 I ANQSEL=2 D ^ANRVAP D:$O(ANRVBAD(0)) BADDAT
110 I $D(ANQMAIL) D
111 .S ANQSUBJ="AMIS Report - "_^DD("SITE")
112 .S ANRVIMN=$$SEND(ANQMAIL,ANQSUBJ) ; Send data via email
113 .I ANRVIMN<1 D Q
114 ..W !,"There was a problem sending the AMIS data.",!
115 .S X=$$SENDCONF(ANQMAIL,ANQSUBJ,ANRVIMN) ; Send confirmation message
116 .I X<1 D Q
117 ..W !,"There was a problem sending the Confirmation Message"
118 ..W !,"back to your mailbox."
119 D ^%ZISC
120CLEAN ; Clean
121 I $D(ZTQUEUED) S ZTREQ="@" Q
122 K ANQBD,ANQED,ANRAS,ANRBD,ANRD,ANRDOD,ANRFVD,ANRND,ANRRD,ANRRFD
123 K ANRRN,ANRVBAD,ANRVIN,ANRVP,ANRP,VAL,QFLG,POP,J,I,DFN,ANQJ
124 K ANQMAIL,ANQSEL,ANRVDIR,ANRVGLB,ANQSUBJ,ANRVFILE,ARRAY
125 K ANRVIMN,ANRVSTR
126 K ^TMP("ANRV",$J),^TMP("ANRV","EMAIL",$J),^TMP("ANRV","CONFIRM",$J)
127 K VAEL,VAERR,DIRUT,DTOUT,DUOUT
128 Q
129BADDAT ;
130 S X="PATIENTS WITH MISSING AMIS DATA" W @IOF,!,?(IOM\2-($L(X)\2)),X
131 W ! F X=1:1:IOM W "="
132 W ! S I="" F S I=$O(ANRVBAD(I)) Q:'I S X=+^ANRV(2040,I,0) W $P(^DPT(X,0),U),?35,$P(^(0),U,9),!
133 Q
134SEND(ANQMAIL,ANQSUBJ) ; Send mail from ^TMP("ANRV","EMAIL",$J)
135 ; Send mail to defined recipient(s) in ANQMAIL
136 S XMSUB=ANQSUBJ,XMCHAN=1,XMDUZ=.5
137 D GET^XMA2
138 I XMZ<1 D Q
139 .W !,"There was a problem obtaining an Internal Message Number."
140 D BUILD
141 S X=ANQMAIL,XMY(X)="",XMY(DUZ)=""
142 S XMTEXT="^TMP(""ANRV"",""EMAIL"",$J,"
143 D ^XMD
144 Q XMZ
145 ;
146SENDCONF(ANQMAIL,ANQSUBJ,ANRVIMN) ; Send Confirmation to User
147 ;
148 S XMSUB=ANQSUBJ,XMCHAN=1,XMDUZ=.5,XMY(DUZ)=""
149 D GET^XMA2
150 S X(1)="This is a confirmation that"
151 S X(2)="message # "_ANRVIMN_" "_ANQSUBJ
152 S X(3)="Has been sent to the Washington, DC"
153 S X(4)="distribution list "_$$GETADDR()_"."
154 S Y=""
155 F S Y=$O(X(Y)) Q:Y="" D
156 .S ^TMP("ANRV","CONFIRM",$J,Y)=X(Y)
157 S XMTEXT="^TMP(""ANRV"",""CONFIRM"",$J,"
158 D ^XMD
159 Q XMZ
160BUILD ; Build AMIS Report to ^TMP("ANRV","EMAIL",$J) to send as email
161 ; Build the Excel portion of the email
162 S L=1
163 S ^TMP("ANRV","EMAIL",$J,L)="~~VA~~",L=L+1
164 S ^TMP("ANRV","EMAIL",$J,L)=^DD("SITE"),L=L+1
165 S X=$O(^ANRV(2041,0))
166 S ^TMP("ANRV","EMAIL",$J,L)=$P(^ANRV(2041,X,0),U,2),L=L+1
167 S X=$$FMTE^XLFDT(ANQBD),Y=$$FMTE^XLFDT(ANQED)
168 S X1=$P(X," "),X2=$P($P(X," ",2),","),X=$P(X,",",2)
169 S X=X2_" "_X1_X
170 S Y1=$P(Y," "),Y2=$P($P(Y," ",2),","),Y=$P(Y,",",2)
171 S Y=Y2_" "_Y1_Y
172 S ^TMP("ANRV","EMAIL",$J,L)=X_","_Y,L=L+1
173 S (I,X)=""
174 S ANRVSTR=$O(^TMP("ANRV",$J,I)),I=ANRVSTR
175 F S I=$O(^TMP("ANRV",$J,I)) Q:I="" D
176 .S X=^TMP("ANRV",$J,I)
177 .S ANRVSTR=ANRVSTR_","_X
178 S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",1,5),L=L+1
179 S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",6,10),L=L+1
180 S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",11,15),L=L+1
181 S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",16,20),L=L+1
182 S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",21,25),L=L+1
183 S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",26,30),L=L+1
184 S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",31,35),L=L+1
185 S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",36,40),L=L+1
186 S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",41,45),L=L+1
187 S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",46,49)_","_ANRVMHE,L=L+1
188 Q
189 ;
190GETADDR() ; Get addresses for AMIS report from VIST Site Parameters
191 ;
192 N X
193 S X=$O(^ANRV(2041,0))
194 S Y=$P($G(^ANRV(2041,X,0)),U,5)
195 Q Y
Note: See TracBrowser for help on using the repository browser.