source: WorldVistAEHR/trunk/r/VISUAL_IMPAIRMENT_SERVICE_TEAM-ANRV/ANRVPR1.m@ 701

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1ANRVPR1 ;AUG/JLTP - FORMAT WP FIELDS FOR VIST PRINTOUT ; 22 Jan 91 / 9:20 AM
2 ;;4.0; Visual Impairment Service Team ;;12 Jun 98
3WP ;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
11PROCESS ;
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
15NEXT ;
16 S ANLT=ANLT+1,ANRV(ANLT)=""
17 Q
18FINISH ; display VIST Coordinator
19 W !!?30,ANRVC(1),!?30,ANRVC(2) D PAGE^ANRVPR ;S ANRVPG=1
20LASTPG ; 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
32EXPAND ;------ 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
35CTRL ;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
39FIELDS ;;
40 ;;VIST Eligible:
41 ;;Visual Activity:
42 ;;Major Activity:
43 ;;Period of Service:
44 ;;VA Entitlement:
45 ;;Age Category:
46 ;;
47AMISPOS ;;
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 ;;
Note: See TracBrowser for help on using the repository browser.