source: WorldVistAEHR/trunk/r/VISUAL_IMPAIRMENT_SERVICE_TEAM-ANRV/ANRVAM2.m@ 1006

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1ANRVAM2 ;MUSK/GLD,MFW,HCIOFO/NDH - VIST AMIS CALC ; 01 Jun 98 / 8:02 AM
2 ;;4.0; Visual Impairment Service Team ;**2**;12 Jun 98
3LOOP3 F S ANRBD=$O(^ANRV(2040,"AB",ANRBD)) Q:ANRBD="" Q:ANRBD>(ANQED+.9) S ANRVP=0 D LOOP4
4PRINT S ANRRFD=ANQBD-.01 G LOOP6
5LOOP4 F S ANRVP=$O(^ANRV(2040,"AB",ANRBD,ANRVP)) Q:ANRVP="" S ANRRD=0 D LOOP5
6 Q
7LOOP5 F S ANRRD=$O(^ANRV(2040,"AB",ANRBD,ANRVP,ANRRD)) Q:ANRRD="" D CHECK2
8 Q
9CHECK2 Q:'$D(^ANRV(2040,ANRVP,6,ANRRD,0)) Q:$P(^ANRV(2040,ANRVP,6,ANRRD,0),"^",2)=""
10 S ANRAS=$P(^ANRV(2040,ANRVP,6,ANRRD,0),"^",2)
11 I ANRAS="035" S ^TMP("ANRV",$J,35)=^TMP("ANRV",$J,35)+1 Q
12 I ANRAS="036" S ^TMP("ANRV",$J,36)=^TMP("ANRV",$J,36)+1 Q
13 I ANRAS="037" S ^TMP("ANRV",$J,37)=^TMP("ANRV",$J,37)+1 Q
14 Q
15LOOP6 F S ANRRFD=$O(^ANRV(2042.5,"C",ANRRFD)) Q:ANRRFD="" Q:ANRRFD>(ANQED+.9) S ANRVP=0 D LOOP7
16 S ANRND=ANQBD-.01 G LOOP12
17LOOP7 F S ANRVP=$O(^ANRV(2042.5,"C",ANRRFD,ANRVP)) Q:ANRVP="" S ANRRN=0 D LOOP8
18 Q
19LOOP8 F S ANRRN=$O(^ANRV(2042.5,"C",ANRRFD,ANRVP,ANRRN)) Q:ANRRN="" D CHECK3
20 Q
21CHECK3 Q:'$D(^ANRV(2042.5,ANRVP,1,ANRRN,2)) Q:$P(^ANRV(2042.5,ANRVP,1,ANRRN,2),"^",1)=""
22 S VAL=$P(^ANRV(2042.5,ANRVP,1,ANRRN,2),"^",1)
23 I VAL="039" S ^TMP("ANRV",$J,39)=^TMP("ANRV",$J,39)+1 Q
24 I VAL="040" S ^TMP("ANRV",$J,40)=^TMP("ANRV",$J,40)+1 Q
25 I VAL="041" S ^TMP("ANRV",$J,41)=^TMP("ANRV",$J,41)+1 Q
26 I VAL="042" S ^TMP("ANRV",$J,42)=^TMP("ANRV",$J,42)+1 Q
27 I VAL="043" S ^TMP("ANRV",$J,43)=^TMP("ANRV",$J,43)+1 Q
28 I VAL="044" S ^TMP("ANRV",$J,44)=^TMP("ANRV",$J,44)+1 Q
29 Q
30LOOP12 F S ANRND=$O(^ANRV(2042.5,"AC",ANRND)) Q:ANRND="" Q:ANRND>(ANQED+.9) S ANRVP=0 D LOOP13
31 S ANRDOD=ANQBD-.01 G LOOP9
32 Q
33LOOP13 F S ANRVP=$O(^ANRV(2042.5,"AC",ANRND,ANRVP)) Q:ANRVP="" S ANRRN=0 D LOOP14
34 Q
35LOOP14 F S ANRRN=$O(^ANRV(2042.5,"AC",ANRND,ANRVP,ANRRN)) Q:ANRRN="" D CHECK4
36 Q
37CHECK4 Q:'$D(^ANRV(2042.5,ANRVP,1,ANRRN,2)) Q:$P(^ANRV(2042.5,ANRVP,1,ANRRN,2),"^",2)=""
38 S VAL=$P(^ANRV(2042.5,ANRVP,1,ANRRN,2),"^",2)
39 I VAL="045" S ^TMP("ANRV",$J,45)=^TMP("ANRV",$J,45)+1 Q
40 I VAL="046" S ^TMP("ANRV",$J,46)=^TMP("ANRV",$J,46)+1 Q
41 Q
42LOOP9 F S ANRDOD=$O(^ANRV(2042.5,"AD",ANRDOD)) Q:ANRDOD="" Q:ANRDOD>(ANQED+.9) S ANRVP=0 D LOOP10
43 Q
44LOOP10 F S ANRVP=$O(^ANRV(2042.5,"AD",ANRDOD,ANRVP)) Q:ANRVP="" S ANRD=0 D LOOP11
45 Q
46LOOP11 F S ANRD=$O(^ANRV(2042.5,"AD",ANRDOD,ANRVP,ANRD)) Q:ANRD="" D CHECK5
47 Q
48CHECK5 Q:'$D(^ANRV(2042.5,ANRVP,1,ANRD,0)) Q:$P(^ANRV(2042.5,ANRVP,1,ANRD,0),"^",6)=""
49 S VAL=$P(^ANRV(2042.5,ANRVP,1,ANRD,0),"^",6)
50 I VAL="047" S ^TMP("ANRV",$J,47)=^TMP("ANRV",$J,47)+1
51 I VAL="048" S ^TMP("ANRV",$J,48)=^TMP("ANRV",$J,48)+1
52 I VAL="049" S ^TMP("ANRV",$J,49)=^TMP("ANRV",$J,49)+1
53 Q
54FV ; this module determines the VIST FIELD VISIT DATES
55 S ANRFVD=(ANQBD-.01) N ANRVPT S ANRVPT=0
56 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
57 Q
Note: See TracBrowser for help on using the repository browser.