ANRVAM1 ;MUSK/GLD,MFW,HCIOFO/NDH - VIST AMIS CALC ; 11 Apr 89 / 9:20 AM
;;4.0; Visual Impairment Service Team ;**2**;12 Jun 98
INTRO W @IOF,"I WILL PRINT THE AMIS REPORT FOR PERIOD SPECIFIED.",!!
;ROUTINE TO CALCULATE ALL VIST AMIS DATA IN FILE BY AMIS CODE.
BDATE S %DT="EXTA",%DT("A")=" BEGINNING AMIS DATE: " D ^%DT Q:Y<0 S ANQBD=Y
EDATE S %DT("A")=" ENDING AMIS DATE: " D ^%DT Q:Y<0 S ANQED=Y
I ANQBD>ANQED D G INTRO
.W !!," Beginning Date greater than Ending Date"
.R X:5
ASKMAIL ; Check to see if user wants to email this report
W !!!,"Do you want to email the AMIS report to the program office?(Y/N)"
D YN^DICN
I %=-1 Q
I %=0 W !,"Answer Y or N" G ASKMAIL
S ANQSEL=%
I ANQSEL=2 D DEVICE Q
F D Q:ANRVMHE="^"!(ANRVMHE?1.4N!(ANRVMHE?1.4N1"."1.2N))
.W !!,"Enter Average Man Hours Expensed by"
.W !,"VIST Coordinator Per Week or ^ to exit: "
.R ANRVMHE:30
.S:'$T ANRVMHE="^"
.Q:ANRVMHE="^"
.S:+ANRVMHE<1 ANRVMHE=""
.I ANRVMHE'?1.4N,ANRVMHE'?1.4N1"."1.2N D
..W !!,"Field 050 - Average Man Hours must be entered"
..W !!,"Must be a number between 1 and 9999.99"
..W !,"Up to 2 decimal precision is allowed."
.; Send mail to specified recipients
.S ANQMAIL=$$GETADDR()
.I ANQMAIL="" D
..W !,"No address is defined in your VIST SITE PARAMATERS"
..W !," for the AMIS report. The AMIS report will not be sent."
..W !," Please enter the appropriate data or contact"
..W !," your system administrator.",!!
..S ANRVMHE="^"
D:ANRVMHE'="^" DQ
Q
DEVICE K IOP S %ZIS="MQ",%ZIS("B")="" D ^%ZIS G:POP CLEAN
I $D(IO("Q")) D G CLEAN
.K IO("Q")
.S ZTSAVE("ANQ*")="",ZTDESC="VIST AMIS",ZTRTN="DQ^ANRVAM1"
.D ^%ZTLOAD
.K ZTSK
DQ K ANRVBAD F ANQJ=0:1:49 S ^TMP("ANRV",$J,ANQJ)=0
D FV^ANRVAM2
S ANRVP=""
F S ANRVP=$O(^ANRV(2040,"B",ANRVP)) Q:ANRVP="" S ANRVIN="" D LOOP2
S ANRBD=(ANQBD-.01) D ^ANRVAM2 G CLOSE
LOOP2 F S ANRVIN=$O(^ANRV(2040,"B",ANRVP,ANRVIN)) Q:ANRVIN="" D CALC
Q
CALC ;
S VAL=""
I '$D(^ANRV(2040,ANRVIN,13)) S ANRVBAD(ANRVIN)="",VAL="" Q
S VAL=$P(^ANRV(2040,ANRVIN,13),"^",2)
I VAL="001" S ^TMP("ANRV",$J,1)=^TMP("ANRV",$J,1)+1 S VAL="" G CALC2
I VAL="002" S ^TMP("ANRV",$J,2)=^TMP("ANRV",$J,2)+1 Q
I VAL="003" S ^TMP("ANRV",$J,3)=^TMP("ANRV",$J,3)+1 Q
Q
CALC2 S VAL=""
I $P(^ANRV(2040,ANRVIN,7),"^",3)'="" S VAL=$P(^ANRV(2040,ANRVIN,7),"^",3)
I VAL="004" S ^TMP("ANRV",$J,4)=^TMP("ANRV",$J,4)+1 G CALC3
I VAL="005" S ^TMP("ANRV",$J,5)=^TMP("ANRV",$J,5)+1 G CALC3
I VAL="006" S ^TMP("ANRV",$J,6)=^TMP("ANRV",$J,6)+1 G CALC3
I VAL="007" S ^TMP("ANRV",$J,7)=^TMP("ANRV",$J,7)+1 G CALC3
I VAL="008" S ^TMP("ANRV",$J,8)=^TMP("ANRV",$J,8)+1 G CALC3
CALC3 S VAL=""
I $P(^ANRV(2040,ANRVIN,7),"^",4)'="" S VAL="",VAL=$P(^ANRV(2040,ANRVIN,7),"^",4)
I VAL="009" S ^TMP("ANRV",$J,9)=^TMP("ANRV",$J,9)+1 G CALC4
I VAL="010" S ^TMP("ANRV",$J,10)=^TMP("ANRV",$J,10)+1 G CALC4
I VAL="011" S ^TMP("ANRV",$J,11)=^TMP("ANRV",$J,11)+1 G CALC4
I VAL="012" S ^TMP("ANRV",$J,12)=^TMP("ANRV",$J,12)+1 G CALC4
I VAL="013" S ^TMP("ANRV",$J,13)=^TMP("ANRV",$J,13)+1 G CALC4
I VAL="014" S ^TMP("ANRV",$J,14)=^TMP("ANRV",$J,14)+1 G CALC4
I VAL="015" S ^TMP("ANRV",$J,15)=^TMP("ANRV",$J,15)+1 G CALC4
CALC4 S VAL="",DFN=ANRVP
D ELIG^VADPT S:$D(VAEL(2)) VAL=$P(VAEL(2),"^")
I VAL=2 S ^TMP("ANRV",$J,16)=^TMP("ANRV",$J,16)+1 G CALC5
I VAL=4 S ^TMP("ANRV",$J,16)=^TMP("ANRV",$J,16)+1 G CALC5
I VAL=3 S ^TMP("ANRV",$J,17)=^TMP("ANRV",$J,17)+1 G CALC5
I VAL=1 S ^TMP("ANRV",$J,18)=^TMP("ANRV",$J,18)+1 G CALC5
I VAL=7 S ^TMP("ANRV",$J,19)=^TMP("ANRV",$J,19)+1 G CALC5
I VAL=6 S ^TMP("ANRV",$J,20)=^TMP("ANRV",$J,20)+1 G CALC5
I VAL=8 S ^TMP("ANRV",$J,20)=^TMP("ANRV",$J,20)+1 G CALC5
I VAL=9 S ^TMP("ANRV",$J,20)=^TMP("ANRV",$J,20)+1 G CALC5
I VAL=5 S ^TMP("ANRV",$J,20)=^TMP("ANRV",$J,20)+1 G CALC5
I VAL=121 S ^TMP("ANRV",$J,20)=^TMP("ANRV",$J,20)+1 G CALC5
S ^TMP("ANRV",$J,21)=^TMP("ANRV",$J,21)+1 G CALC5
CALC5 S VAL=""
I $D(^ANRV(2040,ANRVIN,5)),$P(^ANRV(2040,ANRVIN,5),"^",1)'="" S VAL="",VAL=$P(^ANRV(2040,ANRVIN,5),"^",1)
I VAL="022" S ^TMP("ANRV",$J,22)=^TMP("ANRV",$J,22)+1 G CALC6
I VAL="023" S ^TMP("ANRV",$J,23)=^TMP("ANRV",$J,23)+1 G CALC6
I VAL="024" S ^TMP("ANRV",$J,24)=^TMP("ANRV",$J,24)+1 G CALC6
I VAL="025" S ^TMP("ANRV",$J,25)=^TMP("ANRV",$J,25)+1 G CALC6
CALC6 S VAL="",VAL=$P(^DPT(ANRVP,0),"^",3) G:VAL="" CALC16
S VAL=$E(DT,1,3)-$E(VAL,1,3)-($E(DT,4,7)<$E(VAL,4,7))
I VAL<25 S ^TMP("ANRV",$J,26)=^TMP("ANRV",$J,26)+1 Q
I VAL<35,VAL>24 S ^TMP("ANRV",$J,27)=^TMP("ANRV",$J,27)+1 Q
I VAL<45,VAL>34 S ^TMP("ANRV",$J,28)=^TMP("ANRV",$J,28)+1 Q
I VAL<55,VAL>44 S ^TMP("ANRV",$J,29)=^TMP("ANRV",$J,29)+1 Q
I VAL<65,VAL>54 S ^TMP("ANRV",$J,30)=^TMP("ANRV",$J,30)+1 Q
I VAL<75,VAL>64 S ^TMP("ANRV",$J,31)=^TMP("ANRV",$J,31)+1 Q
I VAL<85,VAL>74 S ^TMP("ANRV",$J,32)=^TMP("ANRV",$J,32)+1 Q
I VAL>84 S ^TMP("ANRV",$J,33)=^TMP("ANRV",$J,33)+1 Q
CALC16 S ^TMP("ANRV",$J,34)=^TMP("ANRV",$J,34)+1 Q
Q
CLOSE ; Check if user wanted to send mail to DC
; and complete report.
;
I ANQSEL=2 D ^ANRVAP D:$O(ANRVBAD(0)) BADDAT
I $D(ANQMAIL) D
.S ANQSUBJ="AMIS Report - "_^DD("SITE")
.S ANRVIMN=$$SEND(ANQMAIL,ANQSUBJ) ; Send data via email
.I ANRVIMN<1 D Q
..W !,"There was a problem sending the AMIS data.",!
.S X=$$SENDCONF(ANQMAIL,ANQSUBJ,ANRVIMN) ; Send confirmation message
.I X<1 D Q
..W !,"There was a problem sending the Confirmation Message"
..W !,"back to your mailbox."
D ^%ZISC
CLEAN ; Clean
I $D(ZTQUEUED) S ZTREQ="@" Q
K ANQBD,ANQED,ANRAS,ANRBD,ANRD,ANRDOD,ANRFVD,ANRND,ANRRD,ANRRFD
K ANRRN,ANRVBAD,ANRVIN,ANRVP,ANRP,VAL,QFLG,POP,J,I,DFN,ANQJ
K ANQMAIL,ANQSEL,ANRVDIR,ANRVGLB,ANQSUBJ,ANRVFILE,ARRAY
K ANRVIMN,ANRVSTR
K ^TMP("ANRV",$J),^TMP("ANRV","EMAIL",$J),^TMP("ANRV","CONFIRM",$J)
K VAEL,VAERR,DIRUT,DTOUT,DUOUT
Q
BADDAT ;
S X="PATIENTS WITH MISSING AMIS DATA" W @IOF,!,?(IOM\2-($L(X)\2)),X
W ! F X=1:1:IOM W "="
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),!
Q
SEND(ANQMAIL,ANQSUBJ) ; Send mail from ^TMP("ANRV","EMAIL",$J)
; Send mail to defined recipient(s) in ANQMAIL
S XMSUB=ANQSUBJ,XMCHAN=1,XMDUZ=.5
D GET^XMA2
I XMZ<1 D Q
.W !,"There was a problem obtaining an Internal Message Number."
D BUILD
S X=ANQMAIL,XMY(X)="",XMY(DUZ)=""
S XMTEXT="^TMP(""ANRV"",""EMAIL"",$J,"
D ^XMD
Q XMZ
;
SENDCONF(ANQMAIL,ANQSUBJ,ANRVIMN) ; Send Confirmation to User
;
S XMSUB=ANQSUBJ,XMCHAN=1,XMDUZ=.5,XMY(DUZ)=""
D GET^XMA2
S X(1)="This is a confirmation that"
S X(2)="message # "_ANRVIMN_" "_ANQSUBJ
S X(3)="Has been sent to the Washington, DC"
S X(4)="distribution list "_$$GETADDR()_"."
S Y=""
F S Y=$O(X(Y)) Q:Y="" D
.S ^TMP("ANRV","CONFIRM",$J,Y)=X(Y)
S XMTEXT="^TMP(""ANRV"",""CONFIRM"",$J,"
D ^XMD
Q XMZ
BUILD ; Build AMIS Report to ^TMP("ANRV","EMAIL",$J) to send as email
; Build the Excel portion of the email
S L=1
S ^TMP("ANRV","EMAIL",$J,L)="~~VA~~",L=L+1
S ^TMP("ANRV","EMAIL",$J,L)=^DD("SITE"),L=L+1
S X=$O(^ANRV(2041,0))
S ^TMP("ANRV","EMAIL",$J,L)=$P(^ANRV(2041,X,0),U,2),L=L+1
S X=$$FMTE^XLFDT(ANQBD),Y=$$FMTE^XLFDT(ANQED)
S X1=$P(X," "),X2=$P($P(X," ",2),","),X=$P(X,",",2)
S X=X2_" "_X1_X
S Y1=$P(Y," "),Y2=$P($P(Y," ",2),","),Y=$P(Y,",",2)
S Y=Y2_" "_Y1_Y
S ^TMP("ANRV","EMAIL",$J,L)=X_","_Y,L=L+1
S (I,X)=""
S ANRVSTR=$O(^TMP("ANRV",$J,I)),I=ANRVSTR
F S I=$O(^TMP("ANRV",$J,I)) Q:I="" D
.S X=^TMP("ANRV",$J,I)
.S ANRVSTR=ANRVSTR_","_X
S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",1,5),L=L+1
S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",6,10),L=L+1
S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",11,15),L=L+1
S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",16,20),L=L+1
S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",21,25),L=L+1
S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",26,30),L=L+1
S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",31,35),L=L+1
S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",36,40),L=L+1
S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",41,45),L=L+1
S ^TMP("ANRV","EMAIL",$J,L)=$P(ANRVSTR,",",46,49)_","_ANRVMHE,L=L+1
Q
;
GETADDR() ; Get addresses for AMIS report from VIST Site Parameters
;
N X
S X=$O(^ANRV(2041,0))
S Y=$P($G(^ANRV(2041,X,0)),U,5)
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HANRVAM1 8287 printed Apr 09, 2024@21:47:49 Page 2
ANRVAM1 ;MUSK/GLD,MFW,HCIOFO/NDH - VIST AMIS CALC ; 11 Apr 89 / 9:20 AM
+1 ;;4.0; Visual Impairment Service Team ;**2**;12 Jun 98
INTRO WRITE @IOF,"I WILL PRINT THE AMIS REPORT FOR PERIOD SPECIFIED.",!!
+1 ;ROUTINE TO CALCULATE ALL VIST AMIS DATA IN FILE BY AMIS CODE.
BDATE SET %DT="EXTA"
SET %DT("A")=" BEGINNING AMIS DATE: "
DO ^%DT
if Y<0
QUIT
SET ANQBD=Y
EDATE SET %DT("A")=" ENDING AMIS DATE: "
DO ^%DT
if Y<0
QUIT
SET ANQED=Y
+1 IF ANQBD>ANQED
Begin DoDot:1
+2 WRITE !!," Beginning Date greater than Ending Date"
+3 READ X:5
End DoDot:1
GOTO INTRO
ASKMAIL ; Check to see if user wants to email this report
+1 WRITE !!!,"Do you want to email the AMIS report to the program office?(Y/N)"
+2 DO YN^DICN
+3 IF %=-1
QUIT
+4 IF %=0
WRITE !,"Answer Y or N"
GOTO ASKMAIL
+5 SET ANQSEL=%
+6 IF ANQSEL=2
DO DEVICE
QUIT
+7 FOR
Begin DoDot:1
+8 WRITE !!,"Enter Average Man Hours Expensed by"
+9 WRITE !,"VIST Coordinator Per Week or ^ to exit: "
+10 READ ANRVMHE:30
+11 if '$TEST
SET ANRVMHE="^"
+12 if ANRVMHE="^"
QUIT
+13 if +ANRVMHE<1
SET ANRVMHE=""
+14 IF ANRVMHE'?1.4N
IF ANRVMHE'?1.4N1"."1.2N
Begin DoDot:2
+15 WRITE !!,"Field 050 - Average Man Hours must be entered"
+16 WRITE !!,"Must be a number between 1 and 9999.99"
+17 WRITE !,"Up to 2 decimal precision is allowed."
End DoDot:2
+18 ; Send mail to specified recipients
+19 SET ANQMAIL=$$GETADDR()
+20 IF ANQMAIL=""
Begin DoDot:2
+21 WRITE !,"No address is defined in your VIST SITE PARAMATERS"
+22 WRITE !," for the AMIS report. The AMIS report will not be sent."
+23 WRITE !," Please enter the appropriate data or contact"
+24 WRITE !," your system administrator.",!!
+25 SET ANRVMHE="^"
End DoDot:2
End DoDot:1
if ANRVMHE="^"!(ANRVMHE?1.4N!(ANRVMHE?1.4N1"."1.2N))
QUIT
+26 if ANRVMHE'="^"
DO DQ
+27 QUIT
DEVICE KILL IOP
SET %ZIS="MQ"
SET %ZIS("B")=""
DO ^%ZIS
if POP
GOTO CLEAN
+1 IF $DATA(IO("Q"))
Begin DoDot:1
+2 KILL IO("Q")
+3 SET ZTSAVE("ANQ*")=""
SET ZTDESC="VIST AMIS"
SET ZTRTN="DQ^ANRVAM1"
+4 DO ^%ZTLOAD
+5 KILL ZTSK
End DoDot:1
GOTO CLEAN
DQ KILL ANRVBAD
FOR ANQJ=0:1:49
SET ^TMP("ANRV",$JOB,ANQJ)=0
+1 DO FV^ANRVAM2
+2 SET ANRVP=""
+3 FOR
SET ANRVP=$ORDER(^ANRV(2040,"B",ANRVP))
if ANRVP=""
QUIT
SET ANRVIN=""
DO LOOP2
+4 SET ANRBD=(ANQBD-.01)
DO ^ANRVAM2
GOTO CLOSE
LOOP2 FOR
SET ANRVIN=$ORDER(^ANRV(2040,"B",ANRVP,ANRVIN))
if ANRVIN=""
QUIT
DO CALC
+1 QUIT
CALC ;
+1 SET VAL=""
+2 IF '$DATA(^ANRV(2040,ANRVIN,13))
SET ANRVBAD(ANRVIN)=""
SET VAL=""
QUIT
+3 SET VAL=$PIECE(^ANRV(2040,ANRVIN,13),"^",2)
+4 IF VAL="001"
SET ^TMP("ANRV",$JOB,1)=^TMP("ANRV",$JOB,1)+1
SET VAL=""
GOTO CALC2
+5 IF VAL="002"
SET ^TMP("ANRV",$JOB,2)=^TMP("ANRV",$JOB,2)+1
QUIT
+6 IF VAL="003"
SET ^TMP("ANRV",$JOB,3)=^TMP("ANRV",$JOB,3)+1
QUIT
+7 QUIT
CALC2 SET VAL=""
+1 IF $PIECE(^ANRV(2040,ANRVIN,7),"^",3)'=""
SET VAL=$PIECE(^ANRV(2040,ANRVIN,7),"^",3)
+2 IF VAL="004"
SET ^TMP("ANRV",$JOB,4)=^TMP("ANRV",$JOB,4)+1
GOTO CALC3
+3 IF VAL="005"
SET ^TMP("ANRV",$JOB,5)=^TMP("ANRV",$JOB,5)+1
GOTO CALC3
+4 IF VAL="006"
SET ^TMP("ANRV",$JOB,6)=^TMP("ANRV",$JOB,6)+1
GOTO CALC3
+5 IF VAL="007"
SET ^TMP("ANRV",$JOB,7)=^TMP("ANRV",$JOB,7)+1
GOTO CALC3
+6 IF VAL="008"
SET ^TMP("ANRV",$JOB,8)=^TMP("ANRV",$JOB,8)+1
GOTO CALC3
CALC3 SET VAL=""
+1 IF $PIECE(^ANRV(2040,ANRVIN,7),"^",4)'=""
SET VAL=""
SET VAL=$PIECE(^ANRV(2040,ANRVIN,7),"^",4)
+2 IF VAL="009"
SET ^TMP("ANRV",$JOB,9)=^TMP("ANRV",$JOB,9)+1
GOTO CALC4
+3 IF VAL="010"
SET ^TMP("ANRV",$JOB,10)=^TMP("ANRV",$JOB,10)+1
GOTO CALC4
+4 IF VAL="011"
SET ^TMP("ANRV",$JOB,11)=^TMP("ANRV",$JOB,11)+1
GOTO CALC4
+5 IF VAL="012"
SET ^TMP("ANRV",$JOB,12)=^TMP("ANRV",$JOB,12)+1
GOTO CALC4
+6 IF VAL="013"
SET ^TMP("ANRV",$JOB,13)=^TMP("ANRV",$JOB,13)+1
GOTO CALC4
+7 IF VAL="014"
SET ^TMP("ANRV",$JOB,14)=^TMP("ANRV",$JOB,14)+1
GOTO CALC4
+8 IF VAL="015"
SET ^TMP("ANRV",$JOB,15)=^TMP("ANRV",$JOB,15)+1
GOTO CALC4
CALC4 SET VAL=""
SET DFN=ANRVP
+1 DO ELIG^VADPT
if $DATA(VAEL(2))
SET VAL=$PIECE(VAEL(2),"^")
+2 IF VAL=2
SET ^TMP("ANRV",$JOB,16)=^TMP("ANRV",$JOB,16)+1
GOTO CALC5
+3 IF VAL=4
SET ^TMP("ANRV",$JOB,16)=^TMP("ANRV",$JOB,16)+1
GOTO CALC5
+4 IF VAL=3
SET ^TMP("ANRV",$JOB,17)=^TMP("ANRV",$JOB,17)+1
GOTO CALC5
+5 IF VAL=1
SET ^TMP("ANRV",$JOB,18)=^TMP("ANRV",$JOB,18)+1
GOTO CALC5
+6 IF VAL=7
SET ^TMP("ANRV",$JOB,19)=^TMP("ANRV",$JOB,19)+1
GOTO CALC5
+7 IF VAL=6
SET ^TMP("ANRV",$JOB,20)=^TMP("ANRV",$JOB,20)+1
GOTO CALC5
+8 IF VAL=8
SET ^TMP("ANRV",$JOB,20)=^TMP("ANRV",$JOB,20)+1
GOTO CALC5
+9 IF VAL=9
SET ^TMP("ANRV",$JOB,20)=^TMP("ANRV",$JOB,20)+1
GOTO CALC5
+10 IF VAL=5
SET ^TMP("ANRV",$JOB,20)=^TMP("ANRV",$JOB,20)+1
GOTO CALC5
+11 IF VAL=121
SET ^TMP("ANRV",$JOB,20)=^TMP("ANRV",$JOB,20)+1
GOTO CALC5
+12 SET ^TMP("ANRV",$JOB,21)=^TMP("ANRV",$JOB,21)+1
GOTO CALC5
CALC5 SET VAL=""
+1 IF $DATA(^ANRV(2040,ANRVIN,5))
IF $PIECE(^ANRV(2040,ANRVIN,5),"^",1)'=""
SET VAL=""
SET VAL=$PIECE(^ANRV(2040,ANRVIN,5),"^",1)
+2 IF VAL="022"
SET ^TMP("ANRV",$JOB,22)=^TMP("ANRV",$JOB,22)+1
GOTO CALC6
+3 IF VAL="023"
SET ^TMP("ANRV",$JOB,23)=^TMP("ANRV",$JOB,23)+1
GOTO CALC6
+4 IF VAL="024"
SET ^TMP("ANRV",$JOB,24)=^TMP("ANRV",$JOB,24)+1
GOTO CALC6
+5 IF VAL="025"
SET ^TMP("ANRV",$JOB,25)=^TMP("ANRV",$JOB,25)+1
GOTO CALC6
CALC6 SET VAL=""
SET VAL=$PIECE(^DPT(ANRVP,0),"^",3)
if VAL=""
GOTO CALC16
+1 SET VAL=$EXTRACT(DT,1,3)-$EXTRACT(VAL,1,3)-($EXTRACT(DT,4,7)<$EXTRACT(VAL,4,7))
+2 IF VAL<25
SET ^TMP("ANRV",$JOB,26)=^TMP("ANRV",$JOB,26)+1
QUIT
+3 IF VAL<35
IF VAL>24
SET ^TMP("ANRV",$JOB,27)=^TMP("ANRV",$JOB,27)+1
QUIT
+4 IF VAL<45
IF VAL>34
SET ^TMP("ANRV",$JOB,28)=^TMP("ANRV",$JOB,28)+1
QUIT
+5 IF VAL<55
IF VAL>44
SET ^TMP("ANRV",$JOB,29)=^TMP("ANRV",$JOB,29)+1
QUIT
+6 IF VAL<65
IF VAL>54
SET ^TMP("ANRV",$JOB,30)=^TMP("ANRV",$JOB,30)+1
QUIT
+7 IF VAL<75
IF VAL>64
SET ^TMP("ANRV",$JOB,31)=^TMP("ANRV",$JOB,31)+1
QUIT
+8 IF VAL<85
IF VAL>74
SET ^TMP("ANRV",$JOB,32)=^TMP("ANRV",$JOB,32)+1
QUIT
+9 IF VAL>84
SET ^TMP("ANRV",$JOB,33)=^TMP("ANRV",$JOB,33)+1
QUIT
CALC16 SET ^TMP("ANRV",$JOB,34)=^TMP("ANRV",$JOB,34)+1
QUIT
+1 QUIT
CLOSE ; Check if user wanted to send mail to DC
+1 ; and complete report.
+2 ;
+3 IF ANQSEL=2
DO ^ANRVAP
if $ORDER(ANRVBAD(0))
DO BADDAT
+4 IF $DATA(ANQMAIL)
Begin DoDot:1
+5 SET ANQSUBJ="AMIS Report - "_^DD("SITE")
+6 ; Send data via email
SET ANRVIMN=$$SEND(ANQMAIL,ANQSUBJ)
+7 IF ANRVIMN<1
Begin DoDot:2
+8 WRITE !,"There was a problem sending the AMIS data.",!
End DoDot:2
QUIT
+9 ; Send confirmation message
SET X=$$SENDCONF(ANQMAIL,ANQSUBJ,ANRVIMN)
+10 IF X<1
Begin DoDot:2
+11 WRITE !,"There was a problem sending the Confirmation Message"
+12 WRITE !,"back to your mailbox."
End DoDot:2
QUIT
End DoDot:1
+13 DO ^%ZISC
CLEAN ; Clean
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
+2 KILL ANQBD,ANQED,ANRAS,ANRBD,ANRD,ANRDOD,ANRFVD,ANRND,ANRRD,ANRRFD
+3 KILL ANRRN,ANRVBAD,ANRVIN,ANRVP,ANRP,VAL,QFLG,POP,J,I,DFN,ANQJ
+4 KILL ANQMAIL,ANQSEL,ANRVDIR,ANRVGLB,ANQSUBJ,ANRVFILE,ARRAY
+5 KILL ANRVIMN,ANRVSTR
+6 KILL ^TMP("ANRV",$JOB),^TMP("ANRV","EMAIL",$JOB),^TMP("ANRV","CONFIRM",$JOB)
+7 KILL VAEL,VAERR,DIRUT,DTOUT,DUOUT
+8 QUIT
BADDAT ;
+1 SET X="PATIENTS WITH MISSING AMIS DATA"
WRITE @IOF,!,?(IOM\2-($LENGTH(X)\2)),X
+2 WRITE !
FOR X=1:1:IOM
WRITE "="
+3 WRITE !
SET I=""
FOR
SET I=$ORDER(ANRVBAD(I))
if 'I
QUIT
SET X=+^ANRV(2040,I,0)
WRITE $PIECE(^DPT(X,0),U),?35,$PIECE(^(0),U,9),!
+4 QUIT
SEND(ANQMAIL,ANQSUBJ) ; Send mail from ^TMP("ANRV","EMAIL",$J)
+1 ; Send mail to defined recipient(s) in ANQMAIL
+2 SET XMSUB=ANQSUBJ
SET XMCHAN=1
SET XMDUZ=.5
+3 DO GET^XMA2
+4 IF XMZ<1
Begin DoDot:1
+5 WRITE !,"There was a problem obtaining an Internal Message Number."
End DoDot:1
QUIT
+6 DO BUILD
+7 SET X=ANQMAIL
SET XMY(X)=""
SET XMY(DUZ)=""
+8 SET XMTEXT="^TMP(""ANRV"",""EMAIL"",$J,"
+9 DO ^XMD
+10 QUIT XMZ
+11 ;
SENDCONF(ANQMAIL,ANQSUBJ,ANRVIMN) ; Send Confirmation to User
+1 ;
+2 SET XMSUB=ANQSUBJ
SET XMCHAN=1
SET XMDUZ=.5
SET XMY(DUZ)=""
+3 DO GET^XMA2
+4 SET X(1)="This is a confirmation that"
+5 SET X(2)="message # "_ANRVIMN_" "_ANQSUBJ
+6 SET X(3)="Has been sent to the Washington, DC"
+7 SET X(4)="distribution list "_$$GETADDR()_"."
+8 SET Y=""
+9 FOR
SET Y=$ORDER(X(Y))
if Y=""
QUIT
Begin DoDot:1
+10 SET ^TMP("ANRV","CONFIRM",$JOB,Y)=X(Y)
End DoDot:1
+11 SET XMTEXT="^TMP(""ANRV"",""CONFIRM"",$J,"
+12 DO ^XMD
+13 QUIT XMZ
BUILD ; Build AMIS Report to ^TMP("ANRV","EMAIL",$J) to send as email
+1 ; Build the Excel portion of the email
+2 SET L=1
+3 SET ^TMP("ANRV","EMAIL",$JOB,L)="~~VA~~"
SET L=L+1
+4 SET ^TMP("ANRV","EMAIL",$JOB,L)=^DD("SITE")
SET L=L+1
+5 SET X=$ORDER(^ANRV(2041,0))
+6 SET ^TMP("ANRV","EMAIL",$JOB,L)=$PIECE(^ANRV(2041,X,0),U,2)
SET L=L+1
+7 SET X=$$FMTE^XLFDT(ANQBD)
SET Y=$$FMTE^XLFDT(ANQED)
+8 SET X1=$PIECE(X," ")
SET X2=$PIECE($PIECE(X," ",2),",")
SET X=$PIECE(X,",",2)
+9 SET X=X2_" "_X1_X
+10 SET Y1=$PIECE(Y," ")
SET Y2=$PIECE($PIECE(Y," ",2),",")
SET Y=$PIECE(Y,",",2)
+11 SET Y=Y2_" "_Y1_Y
+12 SET ^TMP("ANRV","EMAIL",$JOB,L)=X_","_Y
SET L=L+1
+13 SET (I,X)=""
+14 SET ANRVSTR=$ORDER(^TMP("ANRV",$JOB,I))
SET I=ANRVSTR
+15 FOR
SET I=$ORDER(^TMP("ANRV",$JOB,I))
if I=""
QUIT
Begin DoDot:1
+16 SET X=^TMP("ANRV",$JOB,I)
+17 SET ANRVSTR=ANRVSTR_","_X
End DoDot:1
+18 SET ^TMP("ANRV","EMAIL",$JOB,L)=$PIECE(ANRVSTR,",",1,5)
SET L=L+1
+19 SET ^TMP("ANRV","EMAIL",$JOB,L)=$PIECE(ANRVSTR,",",6,10)
SET L=L+1
+20 SET ^TMP("ANRV","EMAIL",$JOB,L)=$PIECE(ANRVSTR,",",11,15)
SET L=L+1
+21 SET ^TMP("ANRV","EMAIL",$JOB,L)=$PIECE(ANRVSTR,",",16,20)
SET L=L+1
+22 SET ^TMP("ANRV","EMAIL",$JOB,L)=$PIECE(ANRVSTR,",",21,25)
SET L=L+1
+23 SET ^TMP("ANRV","EMAIL",$JOB,L)=$PIECE(ANRVSTR,",",26,30)
SET L=L+1
+24 SET ^TMP("ANRV","EMAIL",$JOB,L)=$PIECE(ANRVSTR,",",31,35)
SET L=L+1
+25 SET ^TMP("ANRV","EMAIL",$JOB,L)=$PIECE(ANRVSTR,",",36,40)
SET L=L+1
+26 SET ^TMP("ANRV","EMAIL",$JOB,L)=$PIECE(ANRVSTR,",",41,45)
SET L=L+1
+27 SET ^TMP("ANRV","EMAIL",$JOB,L)=$PIECE(ANRVSTR,",",46,49)_","_ANRVMHE
SET L=L+1
+28 QUIT
+29 ;
GETADDR() ; Get addresses for AMIS report from VIST Site Parameters
+1 ;
+2 NEW X
+3 SET X=$ORDER(^ANRV(2041,0))
+4 SET Y=$PIECE($GET(^ANRV(2041,X,0)),U,5)
+5 QUIT Y
