- 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 Feb 19, 2025@00:12:06 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
