ANRVPR1 ;AUG/JLTP - FORMAT WP FIELDS FOR VIST PRINTOUT ; 22 Jan 91 / 9:20 AM
;;4.0; Visual Impairment Service Team ;;12 Jun 98
WP ;EXPECTS ANRF = GLOBAL NODE^HEADING
W !!,$P(ANRF,U,2) S ANRF=+ANRF
K ANRV S ANLT=0
F ANLF=0:0 S ANLF=$O(^ANRV(2040,ANRVFN,ANRF,ANLF)) Q:'ANLF D
.S ANTXT=^ANRV(2040,ANRVFN,ANRF,ANLF,0) D CTRL D:ANLT=0!($E(ANTXT)=" ") NEXT D PROCESS
F ANRV=0:0 S ANRV=$O(ANRV(ANRV)) Q:'ANRV D Q:$D(DIRUT)
.D:$Y>(IOSL-6) PAGE^ANRVPR Q:$D(DIRUT) W !?30,ANRV(ANRV)
Q
PROCESS ;
F I=1:1:$L(ANTXT," ") S ANWRD=$P(ANTXT," ",I)_" " D
.D:$L(ANRV(ANLT)_ANWRD)>(IOM-35) NEXT S ANRV(ANLT)=ANRV(ANLT)_ANWRD
Q
NEXT ;
S ANLT=ANLT+1,ANRV(ANLT)=""
Q
FINISH ; display VIST Coordinator
W !!?30,ANRVC(1),!?30,ANRVC(2) D PAGE^ANRVPR ;S ANRVPG=1
LASTPG ; Print last page of individual record
I $D(DIRUT) Q
K ANRV S ANRV(1)=$P($G(^ANRV(2040,ANRVFN,13)),U,2),X=$G(^(7))
S ANRV(2)=$P(X,U,3),ANRV(3)=$P(X,U,4),ANRV(5)=$G(^ANRV(2040,ANRVFN,5))
S ANRV(6)=AGE_" ("_$S(AGE<25:"026",AGE<35:"027",AGE<45:"028",AGE<55:"029",AGE<65:"030",AGE<75:"031",AGE<85:"032",1:"033")_")"
S ANRV(4)="" F I=1:1 S ANRV=$P($T(AMISPOS+I),";;",2) Q:ANRV="" D
.I ANRVPS=$P(ANRV,U) S ANRV(4)=ANRVPS_" ("_$P(ANRV,U,2)_")" Q
F ANRV="7^1","4.5^2","9^3","3.5^5" D EXPAND
W !!,"Name: ",?30,PNM,!,"Social Security Number: ",?30,SSN,!!!!?20,"AMIS",!!
F I=1:1:6 W !,$P($T(FIELDS+I),";;",2),?30,ANRV(I)
W ! D FTR^ANRVPR G EXIT^ANRVPR
Q
EXPAND ;------ Expand Set of Codes ------
S Y=ANRV($P(ANRV,"^",2)),C=$P(^DD(2040,+ANRV,0),"^",2) D Y^DIQ S ANRV($P(ANRV,"^",2))=Y
Q
CTRL ;Process control codes. (Only |TAB|s for now...)
F Q:ANTXT'["|TAB|" D
.S ANTXT=$P(ANTXT,"|TAB|")_" "_$P(ANTXT,"|TAB|",2,255)
Q
FIELDS ;;
;;VIST Eligible:
;;Visual Activity:
;;Major Activity:
;;Period of Service:
;;VA Entitlement:
;;Age Category:
;;
AMISPOS ;;
;;WORLD WAR I^016
;;SPANISH AMERICAN^016
;;WORLD WAR II^017
;;KOREAN^018
;;VIETNAM ERA^019
;;PERSIAN GULF WAR^020
;;POST-KOREAN^020
;;POST-VIETNAM^020
;;PRE-KOREAN^020
;;OTHER OR NONE^020
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HANRVPR1 2092 printed Apr 09, 2024@21:47:48 Page 2
ANRVPR1 ;AUG/JLTP - FORMAT WP FIELDS FOR VIST PRINTOUT ; 22 Jan 91 / 9:20 AM
+1 ;;4.0; Visual Impairment Service Team ;;12 Jun 98
WP ;EXPECTS ANRF = GLOBAL NODE^HEADING
+1 WRITE !!,$PIECE(ANRF,U,2)
SET ANRF=+ANRF
+2 KILL ANRV
SET ANLT=0
+3 FOR ANLF=0:0
SET ANLF=$ORDER(^ANRV(2040,ANRVFN,ANRF,ANLF))
if 'ANLF
QUIT
Begin DoDot:1
+4 SET ANTXT=^ANRV(2040,ANRVFN,ANRF,ANLF,0)
DO CTRL
if ANLT=0!($EXTRACT(ANTXT)=" ")
DO NEXT
DO PROCESS
End DoDot:1
+5 FOR ANRV=0:0
SET ANRV=$ORDER(ANRV(ANRV))
if 'ANRV
QUIT
Begin DoDot:1
+6 if $Y>(IOSL-6)
DO PAGE^ANRVPR
if $DATA(DIRUT)
QUIT
WRITE !?30,ANRV(ANRV)
End DoDot:1
if $DATA(DIRUT)
QUIT
+7 QUIT
PROCESS ;
+1 FOR I=1:1:$LENGTH(ANTXT," ")
SET ANWRD=$PIECE(ANTXT," ",I)_" "
Begin DoDot:1
+2 if $LENGTH(ANRV(ANLT)_ANWRD)>(IOM-35)
DO NEXT
SET ANRV(ANLT)=ANRV(ANLT)_ANWRD
End DoDot:1
+3 QUIT
NEXT ;
+1 SET ANLT=ANLT+1
SET ANRV(ANLT)=""
+2 QUIT
FINISH ; display VIST Coordinator
+1 ;S ANRVPG=1
WRITE !!?30,ANRVC(1),!?30,ANRVC(2)
DO PAGE^ANRVPR
LASTPG ; Print last page of individual record
+1 IF $DATA(DIRUT)
QUIT
+2 KILL ANRV
SET ANRV(1)=$PIECE($GET(^ANRV(2040,ANRVFN,13)),U,2)
SET X=$GET(^(7))
+3 SET ANRV(2)=$PIECE(X,U,3)
SET ANRV(3)=$PIECE(X,U,4)
SET ANRV(5)=$GET(^ANRV(2040,ANRVFN,5))
+4 SET ANRV(6)=AGE_" ("_$SELECT(AGE<25:"026",AGE<35:"027",AGE<45:"028",AGE<55:"029",AGE<65:"030",AGE<75:"031",AGE<85:"032",1:"033")_")"
+5 SET ANRV(4)=""
FOR I=1:1
SET ANRV=$PIECE($TEXT(AMISPOS+I),";;",2)
if ANRV=""
QUIT
Begin DoDot:1
+6 IF ANRVPS=$PIECE(ANRV,U)
SET ANRV(4)=ANRVPS_" ("_$PIECE(ANRV,U,2)_")"
QUIT
End DoDot:1
+7 FOR ANRV="7^1","4.5^2","9^3","3.5^5"
DO EXPAND
+8 WRITE !!,"Name: ",?30,PNM,!,"Social Security Number: ",?30,SSN,!!!!?20,"AMIS",!!
+9 FOR I=1:1:6
WRITE !,$PIECE($TEXT(FIELDS+I),";;",2),?30,ANRV(I)
+10 WRITE !
DO FTR^ANRVPR
GOTO EXIT^ANRVPR
+11 QUIT
EXPAND ;------ Expand Set of Codes ------
+1 SET Y=ANRV($PIECE(ANRV,"^",2))
SET C=$PIECE(^DD(2040,+ANRV,0),"^",2)
DO Y^DIQ
SET ANRV($PIECE(ANRV,"^",2))=Y
+2 QUIT
CTRL ;Process control codes. (Only |TAB|s for now...)
+1 FOR
if ANTXT'["|TAB|"
QUIT
Begin DoDot:1
+2 SET ANTXT=$PIECE(ANTXT,"|TAB|")_" "_$PIECE(ANTXT,"|TAB|",2,255)
End DoDot:1
+3 QUIT
FIELDS ;;
+1 ;;VIST Eligible:
+2 ;;Visual Activity:
+3 ;;Major Activity:
+4 ;;Period of Service:
+5 ;;VA Entitlement:
+6 ;;Age Category:
+7 ;;
AMISPOS ;;
+1 ;;WORLD WAR I^016
+2 ;;SPANISH AMERICAN^016
+3 ;;WORLD WAR II^017
+4 ;;KOREAN^018
+5 ;;VIETNAM ERA^019
+6 ;;PERSIAN GULF WAR^020
+7 ;;POST-KOREAN^020
+8 ;;POST-VIETNAM^020
+9 ;;PRE-KOREAN^020
+10 ;;OTHER OR NONE^020
+11 ;;
