source: FOIAVistA/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVPPP4.m@ 1427

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

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1ABSVPPP4 ;EAP ALTOONA PRINTOUT VOLUNTARY SVC. DIRECTORY ;9/24/97 4:41 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**7**;JULY 1994;
3DOC ;HARD-CODED PRINTOUT OF FILE 503339.2
4 ;PROGRAM CREATES 2 TEMPORARY GLOBALS WHICH ARE KILLED AT THE END
5 ;PROGRAM USES PARAMETER PASSING AND IS CALLED BY FM TEMPLATE
6 ;[VOLUNTARY SERVICE DIRECTORY] NEEDS PROGRAM ABSVPPP5 TO RUN.
7ONE(J2) ;;;;;;;;;;;;;;
8NEW ;;;;;;;;;;;;;;NEW EVERYTHING EXCEPT J ;;;;;;;;;;;;;;;;;;;;
9 N COUNT,EOD,FL,G7,GDE,GN,PAGE,HOLD,CT,LC,ABSVK,ABSVL,ABSVG,ABSVM,ABSVZ,ABSVE,ABSVP
10 N CNT,P7,Z7,B1,B2,B3,B4,LL,N7,NICK,NME,TLE,TT,U7,C7,ST,NUM,VS,UP,P7
11 N F7,FLG,ABSVY7,A1,A2,A3,C7,S7,ZP,CS,CC,CP,TOC,COM,FTS,COMF,FTSF,Z2,ZN1
12 N VAVS,ALT,ALT1
13KILL ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14 K ^TMP($J,"ABSV") K ^TMP($J,"ABSV1")
15 K ^TMP("ABSVTMP2") K ^TMP("ABSVTMP1")
16 S CNT=0 S ^TMP("ABSVTMP2",CNT)="" S U7="^" S P7=0
17 I $D(^ABS(503339.2,J2,0)) S CNT=0 S Z7=^ABS(503339.2,J2,0) D HDR D SET D STATION
18PRINTOUT ;;;;;;;;;;;;;;;;;;;;;;;;;;
19 H 1 D ^ABSVPPP5
20END ;;
21 H 1 K ^TMP("ABSVTMP1")
22 K ^TMP("ABSVTMP2")
23 K VAVS,ALT,ALT1,F7,FLG,B1,B2,B3,B4,C7,CNT,J2,Z7,ST,NUM,VS,UP,ABSVY7,P7
24 Q
25HDR ;;;;;;;;;;;;SET FIRST LINE OF REPORT;;;;;;;;;;;;;;;;;;;;;;;
26 S ST=$P(Z7,U7,2) S NUM=$P(Z7,U7,1) S VS=$P(Z7,U7,3) S UP=$P(Z7,U7,10)
27 S P7=P7+1 I UP]"" S ABSVY7=UP D CONVERT1^ABSVPPP3 S UP=ABSVY7
28 S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="STATION NAME: "_ST_" ("_NUM_") "_U7_" VISN #: "_VS_U7_" DATE OF LAST UPDATE: "_UP_U7_" PAGE: "_P7
29 S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
30 ;;W !!!,ST,?43,NUM,?50,"VISN #",VS,?62,"DATE OF LAST UPDATE: ",UP,?107,"PAGE: ",P7
31 Q
32SET ;;;;;;;;;;;;;;;;;;;;FIX ADDRESS PIECES;;;;;;;;;;;;;;;;;;;;;
33 S (A1,A2,A3,C7,S7,ZP,CS,CC,CP)="" S (TOC,COM,FTS,COMF,FTSF)=""
34 S A1=$P(Z7,U7,4) S A2=$P(Z7,U7,5) S A3=$P(Z7,U7,9)
35 S CS=$P(Z7,U7,11) S CC=$P(Z7,U7,12) S CP=$P(Z7,U7,13)
36 S C7=$P(Z7,U7,6) S S7=$P(Z7,U7,7) S ZP=$P(Z7,U7,8) I S7]"" I $D(^DIC(5,S7,0)) S S7=$P(^DIC(5,S7,0),U7,1)
37 I $D(^ABS(503339.2,J2,1)) S ZN1=^ABS(503339.2,J2,1) S COM=$P(ZN1,U7,3) S COMF=$P(ZN1,U7,6) S TOC=$P(ZN1,U7,7) S FTS=$P(ZN1,U7,1) S FTSF=$P(ZN1,U7,5) S ALT=$P(ZN1,U7,4) S ALT2=$P(ZN1,U7,2)
38 D LSET
39 Q
40LSET ;;;;;;;;;;;;;;;;;;;;;;;;;
41 I A1]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=A1
42 I A2]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=A2
43 I A3]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=A3
44 S:C7="" C7="NO CITY" S:S7="" S7="NO STATE" S:ZP="" ZP="NO ZIP"
45 S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=C7_", "_S7_" "_ZP
46 S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
47 I COM]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="COMM #: "_COM
48 I ALT]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="ALT. COMM #: "_ALT
49 I FTS]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="FTS #: "_FTS
50 I ALT2]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="ALT. FTS #: "_ALT2
51 I COMF]""!(FTSF]"") S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="COMM FAX: "_COMF_" FTS FAX: "_FTSF
52 S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
53 I TOC]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="TITLE OF CHIEF: "_TOC
54 I CS]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="CHIEF'S SUPERVISOR: "_CS
55 I CC]"" S CC=$S(CC=0:"NO",CC=1:"YES",1:"UNK")
56 I CP]"" S CP=$S(CP="O":"OTHER",CP="V":"VISN CHIEF",CP="R":"REPRESENTATIVE",CP="M":"MEMBER AT LARGE",1:"UNK")
57 I CC]""!(CP]"") S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="NATIONAL POSITION: "_CC_" POSITION HELD: "_CP I CC="NO" S ^TMP("ABSVTMP2",J2,CNT)="NATIONAL POSITION: "_CC
58 S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
59 K C7,S7,ZP,TOC
60 I $D(^ABS(503339.2,J2,2,0)) S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="STAFF: " S TT=0 F LL=1:1 S TT=$O(^ABS(503339.2,J2,2,TT)) Q:'TT!(TT="") S (TLE,NME,NICK,EOD,GDE)="" D SUBSET
61 Q
62SUBSET ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
63 S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
64 S Z2=^ABS(503339.2,J2,2,TT,0) S TLE=$P(Z2,U7,1),NME=$P(Z2,U7,2)
65 I TLE]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="TITLE: "_TLE
66 I NME]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="NAME: "_NME
67 S NICK=$P(Z2,U7,5) I NICK]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="NICKNAME: "_NICK
68 S EOD=$P(Z2,U7,4) S GDE=$P(Z2,U7,3)
69 I EOD]"" S ABSVY7=EOD D DATEONLY^ABSVPPP3 S EOD=ABSVY7 K ABSVY7
70 I EOD]""!(GDE]"") S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="EOD: "_EOD_" GRADE: "_GDE
71 Q
72STATION ;;;;;;;;;;BEGIN SETTING COL 2 PIECES;;;;;;;;;;;;
73 S FL=0 S COUNT=2
74 I $D(^ABS(503339.2,J2,3,0)) S K=0 F T=1:1 S K=$O(^ABS(503339.2,J2,3,K)) Q:'K!(K="") I $D(^ABS(503339.2,J2,3,K,0)) S FL=1 D
75 .S ZN=^ABS(503339.2,J2,3,K,0) S ON=$P(ZN,U7,1),TW=$P(ZN,U7,2),TH=$P(ZN,U7,3),FO=$P(ZN,U7,4),FI=$P(ZN,U7,5),SI=$P(ZN,U7,6) S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="SEC STA NAME: "_TW_" SEC STA #: "_ON
76 .S VAVS=$P(ZN,U7,7) I VAVS]"" S:VAVS=1 VAVS="YES" S:VAVS=0 VAVS="NO" S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="VAVS COMMITTEE: "_VAVS
77 .I TH]"" S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="SEC STA COMM #: "_FO
78 .I FO]"" S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="SEC STA FTS #: "_TH
79 .I FI]"" S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="SEC STA COMM FAX: "_SI
80 .I SI]"" S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="SEC STA FTS FAX: "_FI
81 .S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)=" "
82 I $D(^ABS(503339.2,J2,4,0)) S COUNT=COUNT+1,^TMP("ABSVTMP1",J2,COUNT)=" ",FLG=0 S:FL=0 COUNT=3 S ^TMP("ABSVTMP1",J2,COUNT)="PROGRAMS SUPERVISED: ",N7=0 F G7=1:1 S N7=$O(^ABS(503339.2,J2,4,N7)) Q:'N7!(N7="") I $D(^ABS(503339.2,J2,4,N7,0)) D
83 .S GN=$P(^ABS(503339.2,J2,4,N7,0),U7,1) I GN]"" I $D(^ABS(503339.3,GN,0)) S GNE=$P(^ABS(503339.3,GN,0),U7,2) S COUNT=COUNT+1 S:GN'=1 ^TMP("ABSVTMP1",J2,COUNT)=" "_GNE K GNE S:GN=1 FLG=FLG+1 D
84 ..I GN=1 S:FLG=1 ^TMP("ABSVTMP1",J2,COUNT)=" " S:FLG=1 COUNT=COUNT+1 S:FLG=1 ^TMP("ABSVTMP1",J2,COUNT)="OTHER PROGRAMS SUPERVISED: "
85 ..I GN=1 S F7=$P(^ABS(503339.2,J2,4,N7,0),U7,2) S:F7]"" COUNT=COUNT+1 S:FLG>1 COUNT=COUNT-1 S:F7]"" ^TMP("ABSVTMP1",J2,COUNT)=" "_$P(^ABS(503339.2,J2,4,N7,0),U7,2)
86 Q
Note: See TracBrowser for help on using the repository browser.