Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ANRVAM2

ANRVAM2.m

Go to the documentation of this file.
ANRVAM2 ;MUSK/GLD,MFW,HCIOFO/NDH - VIST AMIS CALC ; 01 Jun 98 / 8:02 AM
 ;;4.0; Visual Impairment Service Team ;**2**;12 Jun 98
LOOP3 F  S ANRBD=$O(^ANRV(2040,"AB",ANRBD)) Q:ANRBD=""  Q:ANRBD>(ANQED+.9)  S ANRVP=0 D LOOP4
PRINT S ANRRFD=ANQBD-.01 G LOOP6
LOOP4 F  S ANRVP=$O(^ANRV(2040,"AB",ANRBD,ANRVP)) Q:ANRVP=""  S ANRRD=0 D LOOP5
 Q
LOOP5 F  S ANRRD=$O(^ANRV(2040,"AB",ANRBD,ANRVP,ANRRD)) Q:ANRRD=""  D CHECK2
 Q
CHECK2 Q:'$D(^ANRV(2040,ANRVP,6,ANRRD,0))  Q:$P(^ANRV(2040,ANRVP,6,ANRRD,0),"^",2)=""
 S ANRAS=$P(^ANRV(2040,ANRVP,6,ANRRD,0),"^",2)
 I ANRAS="035" S ^TMP("ANRV",$J,35)=^TMP("ANRV",$J,35)+1 Q
 I ANRAS="036" S ^TMP("ANRV",$J,36)=^TMP("ANRV",$J,36)+1 Q
 I ANRAS="037" S ^TMP("ANRV",$J,37)=^TMP("ANRV",$J,37)+1 Q
 Q
LOOP6 F  S ANRRFD=$O(^ANRV(2042.5,"C",ANRRFD)) Q:ANRRFD=""  Q:ANRRFD>(ANQED+.9)  S ANRVP=0 D LOOP7
 S ANRND=ANQBD-.01 G LOOP12
LOOP7 F  S ANRVP=$O(^ANRV(2042.5,"C",ANRRFD,ANRVP)) Q:ANRVP=""  S ANRRN=0 D LOOP8
 Q
LOOP8 F  S ANRRN=$O(^ANRV(2042.5,"C",ANRRFD,ANRVP,ANRRN)) Q:ANRRN=""  D CHECK3
 Q
CHECK3 Q:'$D(^ANRV(2042.5,ANRVP,1,ANRRN,2))  Q:$P(^ANRV(2042.5,ANRVP,1,ANRRN,2),"^",1)=""
 S VAL=$P(^ANRV(2042.5,ANRVP,1,ANRRN,2),"^",1)
 I VAL="039" S ^TMP("ANRV",$J,39)=^TMP("ANRV",$J,39)+1 Q
 I VAL="040" S ^TMP("ANRV",$J,40)=^TMP("ANRV",$J,40)+1 Q
 I VAL="041" S ^TMP("ANRV",$J,41)=^TMP("ANRV",$J,41)+1 Q
 I VAL="042" S ^TMP("ANRV",$J,42)=^TMP("ANRV",$J,42)+1 Q
 I VAL="043" S ^TMP("ANRV",$J,43)=^TMP("ANRV",$J,43)+1 Q
 I VAL="044" S ^TMP("ANRV",$J,44)=^TMP("ANRV",$J,44)+1 Q
 Q
LOOP12 F  S ANRND=$O(^ANRV(2042.5,"AC",ANRND)) Q:ANRND=""  Q:ANRND>(ANQED+.9)  S ANRVP=0 D LOOP13
 S ANRDOD=ANQBD-.01 G LOOP9
 Q
LOOP13 F  S ANRVP=$O(^ANRV(2042.5,"AC",ANRND,ANRVP)) Q:ANRVP=""  S ANRRN=0 D LOOP14
 Q
LOOP14 F  S ANRRN=$O(^ANRV(2042.5,"AC",ANRND,ANRVP,ANRRN)) Q:ANRRN=""  D CHECK4
 Q
CHECK4 Q:'$D(^ANRV(2042.5,ANRVP,1,ANRRN,2))  Q:$P(^ANRV(2042.5,ANRVP,1,ANRRN,2),"^",2)=""
 S VAL=$P(^ANRV(2042.5,ANRVP,1,ANRRN,2),"^",2)
 I VAL="045" S ^TMP("ANRV",$J,45)=^TMP("ANRV",$J,45)+1 Q
 I VAL="046" S ^TMP("ANRV",$J,46)=^TMP("ANRV",$J,46)+1 Q
 Q
LOOP9 F  S ANRDOD=$O(^ANRV(2042.5,"AD",ANRDOD)) Q:ANRDOD=""  Q:ANRDOD>(ANQED+.9)  S ANRVP=0 D LOOP10
 Q
LOOP10 F  S ANRVP=$O(^ANRV(2042.5,"AD",ANRDOD,ANRVP)) Q:ANRVP=""  S ANRD=0 D LOOP11
 Q
LOOP11 F  S ANRD=$O(^ANRV(2042.5,"AD",ANRDOD,ANRVP,ANRD)) Q:ANRD=""  D CHECK5
 Q
CHECK5 Q:'$D(^ANRV(2042.5,ANRVP,1,ANRD,0))  Q:$P(^ANRV(2042.5,ANRVP,1,ANRD,0),"^",6)=""
 S VAL=$P(^ANRV(2042.5,ANRVP,1,ANRD,0),"^",6)
 I VAL="047" S ^TMP("ANRV",$J,47)=^TMP("ANRV",$J,47)+1
 I VAL="048" S ^TMP("ANRV",$J,48)=^TMP("ANRV",$J,48)+1
 I VAL="049" S ^TMP("ANRV",$J,49)=^TMP("ANRV",$J,49)+1
 Q
FV ; this module determines the VIST FIELD VISIT DATES
 S ANRFVD=(ANQBD-.01) N ANRVPT S ANRVPT=0
 F  S ANRFVD=$O(^ANRV(2040,"AC",ANRFVD)) Q:ANRFVD=""  Q:ANRFVD>(ANQED+.9)  F  S ANRVPT=$O(^ANRV(2040,"AC",ANRFVD,ANRVPT)) Q:'ANRVPT  S ^TMP("ANRV",$J,38)=^TMP("ANRV",$J,38)+1
 Q