| 1 | ANRVAM1 ;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
|
---|
| 3 | INTRO W @IOF,"I WILL PRINT THE AMIS REPORT FOR PERIOD SPECIFIED.",!!
|
---|
| 4 | ;ROUTINE TO CALCULATE ALL VIST AMIS DATA IN FILE BY AMIS CODE.
|
---|
| 5 | BDATE S %DT="EXTA",%DT("A")=" BEGINNING AMIS DATE: " D ^%DT Q:Y<0 S ANQBD=Y
|
---|
| 6 | EDATE 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
|
---|
| 10 | ASKMAIL ; 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
|
---|
| 38 | DEVICE 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
|
---|
| 44 | DQ 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
|
---|
| 49 | LOOP2 F S ANRVIN=$O(^ANRV(2040,"B",ANRVP,ANRVIN)) Q:ANRVIN="" D CALC
|
---|
| 50 | Q
|
---|
| 51 | CALC ;
|
---|
| 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
|
---|
| 59 | CALC2 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
|
---|
| 66 | CALC3 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
|
---|
| 75 | CALC4 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
|
---|
| 88 | CALC5 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
|
---|
| 94 | CALC6 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
|
---|
| 104 | CALC16 S ^TMP("ANRV",$J,34)=^TMP("ANRV",$J,34)+1 Q
|
---|
| 105 | Q
|
---|
| 106 | CLOSE ; 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
|
---|
| 120 | CLEAN ; 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
|
---|
| 129 | BADDAT ;
|
---|
| 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
|
---|
| 134 | SEND(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 | ;
|
---|
| 146 | SENDCONF(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
|
---|
| 160 | BUILD ; 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 | ;
|
---|
| 190 | GETADDR() ; 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
|
---|