| 1 | ANRVAM2 ;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
|
|---|
| 3 | LOOP3 F S ANRBD=$O(^ANRV(2040,"AB",ANRBD)) Q:ANRBD="" Q:ANRBD>(ANQED+.9) S ANRVP=0 D LOOP4
|
|---|
| 4 | PRINT S ANRRFD=ANQBD-.01 G LOOP6
|
|---|
| 5 | LOOP4 F S ANRVP=$O(^ANRV(2040,"AB",ANRBD,ANRVP)) Q:ANRVP="" S ANRRD=0 D LOOP5
|
|---|
| 6 | Q
|
|---|
| 7 | LOOP5 F S ANRRD=$O(^ANRV(2040,"AB",ANRBD,ANRVP,ANRRD)) Q:ANRRD="" D CHECK2
|
|---|
| 8 | Q
|
|---|
| 9 | CHECK2 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
|
|---|
| 15 | LOOP6 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
|
|---|
| 17 | LOOP7 F S ANRVP=$O(^ANRV(2042.5,"C",ANRRFD,ANRVP)) Q:ANRVP="" S ANRRN=0 D LOOP8
|
|---|
| 18 | Q
|
|---|
| 19 | LOOP8 F S ANRRN=$O(^ANRV(2042.5,"C",ANRRFD,ANRVP,ANRRN)) Q:ANRRN="" D CHECK3
|
|---|
| 20 | Q
|
|---|
| 21 | CHECK3 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
|
|---|
| 30 | LOOP12 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
|
|---|
| 33 | LOOP13 F S ANRVP=$O(^ANRV(2042.5,"AC",ANRND,ANRVP)) Q:ANRVP="" S ANRRN=0 D LOOP14
|
|---|
| 34 | Q
|
|---|
| 35 | LOOP14 F S ANRRN=$O(^ANRV(2042.5,"AC",ANRND,ANRVP,ANRRN)) Q:ANRRN="" D CHECK4
|
|---|
| 36 | Q
|
|---|
| 37 | CHECK4 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
|
|---|
| 42 | LOOP9 F S ANRDOD=$O(^ANRV(2042.5,"AD",ANRDOD)) Q:ANRDOD="" Q:ANRDOD>(ANQED+.9) S ANRVP=0 D LOOP10
|
|---|
| 43 | Q
|
|---|
| 44 | LOOP10 F S ANRVP=$O(^ANRV(2042.5,"AD",ANRDOD,ANRVP)) Q:ANRVP="" S ANRD=0 D LOOP11
|
|---|
| 45 | Q
|
|---|
| 46 | LOOP11 F S ANRD=$O(^ANRV(2042.5,"AD",ANRDOD,ANRVP,ANRD)) Q:ANRD="" D CHECK5
|
|---|
| 47 | Q
|
|---|
| 48 | CHECK5 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
|
|---|
| 54 | FV ; 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
|
|---|
