| [613] | 1 | ANRVPR1 ;AUG/JLTP - FORMAT WP FIELDS FOR VIST PRINTOUT ; 22 Jan 91 / 9:20 AM
|
|---|
| 2 | ;;4.0; Visual Impairment Service Team ;;12 Jun 98
|
|---|
| 3 | WP ;EXPECTS ANRF = GLOBAL NODE^HEADING
|
|---|
| 4 | W !!,$P(ANRF,U,2) S ANRF=+ANRF
|
|---|
| 5 | K ANRV S ANLT=0
|
|---|
| 6 | F ANLF=0:0 S ANLF=$O(^ANRV(2040,ANRVFN,ANRF,ANLF)) Q:'ANLF D
|
|---|
| 7 | .S ANTXT=^ANRV(2040,ANRVFN,ANRF,ANLF,0) D CTRL D:ANLT=0!($E(ANTXT)=" ") NEXT D PROCESS
|
|---|
| 8 | F ANRV=0:0 S ANRV=$O(ANRV(ANRV)) Q:'ANRV D Q:$D(DIRUT)
|
|---|
| 9 | .D:$Y>(IOSL-6) PAGE^ANRVPR Q:$D(DIRUT) W !?30,ANRV(ANRV)
|
|---|
| 10 | Q
|
|---|
| 11 | PROCESS ;
|
|---|
| 12 | F I=1:1:$L(ANTXT," ") S ANWRD=$P(ANTXT," ",I)_" " D
|
|---|
| 13 | .D:$L(ANRV(ANLT)_ANWRD)>(IOM-35) NEXT S ANRV(ANLT)=ANRV(ANLT)_ANWRD
|
|---|
| 14 | Q
|
|---|
| 15 | NEXT ;
|
|---|
| 16 | S ANLT=ANLT+1,ANRV(ANLT)=""
|
|---|
| 17 | Q
|
|---|
| 18 | FINISH ; display VIST Coordinator
|
|---|
| 19 | W !!?30,ANRVC(1),!?30,ANRVC(2) D PAGE^ANRVPR ;S ANRVPG=1
|
|---|
| 20 | LASTPG ; Print last page of individual record
|
|---|
| 21 | I $D(DIRUT) Q
|
|---|
| 22 | K ANRV S ANRV(1)=$P($G(^ANRV(2040,ANRVFN,13)),U,2),X=$G(^(7))
|
|---|
| 23 | S ANRV(2)=$P(X,U,3),ANRV(3)=$P(X,U,4),ANRV(5)=$G(^ANRV(2040,ANRVFN,5))
|
|---|
| 24 | 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")_")"
|
|---|
| 25 | S ANRV(4)="" F I=1:1 S ANRV=$P($T(AMISPOS+I),";;",2) Q:ANRV="" D
|
|---|
| 26 | .I ANRVPS=$P(ANRV,U) S ANRV(4)=ANRVPS_" ("_$P(ANRV,U,2)_")" Q
|
|---|
| 27 | F ANRV="7^1","4.5^2","9^3","3.5^5" D EXPAND
|
|---|
| 28 | W !!,"Name: ",?30,PNM,!,"Social Security Number: ",?30,SSN,!!!!?20,"AMIS",!!
|
|---|
| 29 | F I=1:1:6 W !,$P($T(FIELDS+I),";;",2),?30,ANRV(I)
|
|---|
| 30 | W ! D FTR^ANRVPR G EXIT^ANRVPR
|
|---|
| 31 | Q
|
|---|
| 32 | EXPAND ;------ Expand Set of Codes ------
|
|---|
| 33 | S Y=ANRV($P(ANRV,"^",2)),C=$P(^DD(2040,+ANRV,0),"^",2) D Y^DIQ S ANRV($P(ANRV,"^",2))=Y
|
|---|
| 34 | Q
|
|---|
| 35 | CTRL ;Process control codes. (Only |TAB|s for now...)
|
|---|
| 36 | F Q:ANTXT'["|TAB|" D
|
|---|
| 37 | .S ANTXT=$P(ANTXT,"|TAB|")_" "_$P(ANTXT,"|TAB|",2,255)
|
|---|
| 38 | Q
|
|---|
| 39 | FIELDS ;;
|
|---|
| 40 | ;;VIST Eligible:
|
|---|
| 41 | ;;Visual Activity:
|
|---|
| 42 | ;;Major Activity:
|
|---|
| 43 | ;;Period of Service:
|
|---|
| 44 | ;;VA Entitlement:
|
|---|
| 45 | ;;Age Category:
|
|---|
| 46 | ;;
|
|---|
| 47 | AMISPOS ;;
|
|---|
| 48 | ;;WORLD WAR I^016
|
|---|
| 49 | ;;SPANISH AMERICAN^016
|
|---|
| 50 | ;;WORLD WAR II^017
|
|---|
| 51 | ;;KOREAN^018
|
|---|
| 52 | ;;VIETNAM ERA^019
|
|---|
| 53 | ;;PERSIAN GULF WAR^020
|
|---|
| 54 | ;;POST-KOREAN^020
|
|---|
| 55 | ;;POST-VIETNAM^020
|
|---|
| 56 | ;;PRE-KOREAN^020
|
|---|
| 57 | ;;OTHER OR NONE^020
|
|---|
| 58 | ;;
|
|---|
