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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HANRVAM2 2966 printed Dec 13, 2024@02:45:36 Page 2
ANRVAM2 ;MUSK/GLD,MFW,HCIOFO/NDH - VIST AMIS CALC ; 01 Jun 98 / 8:02 AM
+1 ;;4.0; Visual Impairment Service Team ;**2**;12 Jun 98
LOOP3 FOR
SET ANRBD=$ORDER(^ANRV(2040,"AB",ANRBD))
if ANRBD=""
QUIT
if ANRBD>(ANQED+.9)
QUIT
SET ANRVP=0
DO LOOP4
PRINT SET ANRRFD=ANQBD-.01
GOTO LOOP6
LOOP4 FOR
SET ANRVP=$ORDER(^ANRV(2040,"AB",ANRBD,ANRVP))
if ANRVP=""
QUIT
SET ANRRD=0
DO LOOP5
+1 QUIT
LOOP5 FOR
SET ANRRD=$ORDER(^ANRV(2040,"AB",ANRBD,ANRVP,ANRRD))
if ANRRD=""
QUIT
DO CHECK2
+1 QUIT
CHECK2 if '$DATA(^ANRV(2040,ANRVP,6,ANRRD,0))
QUIT
if $PIECE(^ANRV(2040,ANRVP,6,ANRRD,0),"^",2)=""
QUIT
+1 SET ANRAS=$PIECE(^ANRV(2040,ANRVP,6,ANRRD,0),"^",2)
+2 IF ANRAS="035"
SET ^TMP("ANRV",$JOB,35)=^TMP("ANRV",$JOB,35)+1
QUIT
+3 IF ANRAS="036"
SET ^TMP("ANRV",$JOB,36)=^TMP("ANRV",$JOB,36)+1
QUIT
+4 IF ANRAS="037"
SET ^TMP("ANRV",$JOB,37)=^TMP("ANRV",$JOB,37)+1
QUIT
+5 QUIT
LOOP6 FOR
SET ANRRFD=$ORDER(^ANRV(2042.5,"C",ANRRFD))
if ANRRFD=""
QUIT
if ANRRFD>(ANQED+.9)
QUIT
SET ANRVP=0
DO LOOP7
+1 SET ANRND=ANQBD-.01
GOTO LOOP12
LOOP7 FOR
SET ANRVP=$ORDER(^ANRV(2042.5,"C",ANRRFD,ANRVP))
if ANRVP=""
QUIT
SET ANRRN=0
DO LOOP8
+1 QUIT
LOOP8 FOR
SET ANRRN=$ORDER(^ANRV(2042.5,"C",ANRRFD,ANRVP,ANRRN))
if ANRRN=""
QUIT
DO CHECK3
+1 QUIT
CHECK3 if '$DATA(^ANRV(2042.5,ANRVP,1,ANRRN,2))
QUIT
if $PIECE(^ANRV(2042.5,ANRVP,1,ANRRN,2),"^",1)=""
QUIT
+1 SET VAL=$PIECE(^ANRV(2042.5,ANRVP,1,ANRRN,2),"^",1)
+2 IF VAL="039"
SET ^TMP("ANRV",$JOB,39)=^TMP("ANRV",$JOB,39)+1
QUIT
+3 IF VAL="040"
SET ^TMP("ANRV",$JOB,40)=^TMP("ANRV",$JOB,40)+1
QUIT
+4 IF VAL="041"
SET ^TMP("ANRV",$JOB,41)=^TMP("ANRV",$JOB,41)+1
QUIT
+5 IF VAL="042"
SET ^TMP("ANRV",$JOB,42)=^TMP("ANRV",$JOB,42)+1
QUIT
+6 IF VAL="043"
SET ^TMP("ANRV",$JOB,43)=^TMP("ANRV",$JOB,43)+1
QUIT
+7 IF VAL="044"
SET ^TMP("ANRV",$JOB,44)=^TMP("ANRV",$JOB,44)+1
QUIT
+8 QUIT
LOOP12 FOR
SET ANRND=$ORDER(^ANRV(2042.5,"AC",ANRND))
if ANRND=""
QUIT
if ANRND>(ANQED+.9)
QUIT
SET ANRVP=0
DO LOOP13
+1 SET ANRDOD=ANQBD-.01
GOTO LOOP9
+2 QUIT
LOOP13 FOR
SET ANRVP=$ORDER(^ANRV(2042.5,"AC",ANRND,ANRVP))
if ANRVP=""
QUIT
SET ANRRN=0
DO LOOP14
+1 QUIT
LOOP14 FOR
SET ANRRN=$ORDER(^ANRV(2042.5,"AC",ANRND,ANRVP,ANRRN))
if ANRRN=""
QUIT
DO CHECK4
+1 QUIT
CHECK4 if '$DATA(^ANRV(2042.5,ANRVP,1,ANRRN,2))
QUIT
if $PIECE(^ANRV(2042.5,ANRVP,1,ANRRN,2),"^",2)=""
QUIT
+1 SET VAL=$PIECE(^ANRV(2042.5,ANRVP,1,ANRRN,2),"^",2)
+2 IF VAL="045"
SET ^TMP("ANRV",$JOB,45)=^TMP("ANRV",$JOB,45)+1
QUIT
+3 IF VAL="046"
SET ^TMP("ANRV",$JOB,46)=^TMP("ANRV",$JOB,46)+1
QUIT
+4 QUIT
LOOP9 FOR
SET ANRDOD=$ORDER(^ANRV(2042.5,"AD",ANRDOD))
if ANRDOD=""
QUIT
if ANRDOD>(ANQED+.9)
QUIT
SET ANRVP=0
DO LOOP10
+1 QUIT
LOOP10 FOR
SET ANRVP=$ORDER(^ANRV(2042.5,"AD",ANRDOD,ANRVP))
if ANRVP=""
QUIT
SET ANRD=0
DO LOOP11
+1 QUIT
LOOP11 FOR
SET ANRD=$ORDER(^ANRV(2042.5,"AD",ANRDOD,ANRVP,ANRD))
if ANRD=""
QUIT
DO CHECK5
+1 QUIT
CHECK5 if '$DATA(^ANRV(2042.5,ANRVP,1,ANRD,0))
QUIT
if $PIECE(^ANRV(2042.5,ANRVP,1,ANRD,0),"^",6)=""
QUIT
+1 SET VAL=$PIECE(^ANRV(2042.5,ANRVP,1,ANRD,0),"^",6)
+2 IF VAL="047"
SET ^TMP("ANRV",$JOB,47)=^TMP("ANRV",$JOB,47)+1
+3 IF VAL="048"
SET ^TMP("ANRV",$JOB,48)=^TMP("ANRV",$JOB,48)+1
+4 IF VAL="049"
SET ^TMP("ANRV",$JOB,49)=^TMP("ANRV",$JOB,49)+1
+5 QUIT
FV ; this module determines the VIST FIELD VISIT DATES
+1 SET ANRFVD=(ANQBD-.01)
NEW ANRVPT
SET ANRVPT=0
+2 FOR
SET ANRFVD=$ORDER(^ANRV(2040,"AC",ANRFVD))
if ANRFVD=""
QUIT
if ANRFVD>(ANQED+.9)
QUIT
FOR
SET ANRVPT=$ORDER(^ANRV(2040,"AC",ANRFVD,ANRVPT))
if 'ANRVPT
QUIT
SET ^TMP("ANRV",$JOB,38)=^TMP("ANRV",$JOB,38)+1
+3 QUIT
