source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVPPP2.m@ 1604

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

initial load of WorldVistAEHR

File size: 5.9 KB
Line 
1ABSVPPP2 ;EAP ALTOONA PRINTOUT VOLUNTARY SVC. DIRECTORY ;1/11/01 10:20 AM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**7,23**;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 ABSVPPP3 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
13 K ^TMP("ABSVTMP2") K ^TMP("ABSVTMP1")
14 S CNT=0 S ^TMP("ABSVTMP2",CNT)="" S U7="^" S P7=0
15 I $D(^ABS(503339.2,J2,0)) S CNT=0 S Z7=^ABS(503339.2,J2,0) D HDR D SET D STATION
16PRINTOUT ;;;;;;;;;;;;;;;;;;;;;;;;;;
17 D ^ABSVPPP3
18END ;;
19 K ^TMP("ABSVTMP1")
20 K ^TMP("ABSVTMP2")
21 K SEX,VAVS,ALT,ALT1,F7,FLG,B1,B2,B3,B4,C7,CNT,J2,Z7,ST,NUM,VS,UP,ABSVY7,P7,PRIMST
22 Q
23HDR ;;;;;;;;;;;;SET FIRST LINE OF REPORT;;;;;;;;;;;;;;;;;;;;;;;
24 S ST=$P(Z7,U7,2) S NUM=$P(Z7,U7,1) S VS=$P(Z7,U7,3) S UP=$P(Z7,U7,10)
25 S P7=P7+1 I UP]"" S ABSVY7=UP D CONVERT1^ABSVPPP3 S UP=ABSVY7
26 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
27 S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
28 ;;W !!!,ST,?43,NUM,?50,"VISN #",VS,?62,"DATE OF LAST UPDATE: ",UP,?107,"PAGE: ",P7
29 Q
30SET ;;;;;;;;;;;;;;;;;;;;FIX ADDRESS PIECES;;;;;;;;;;;;;;;;;;;;;
31 S (A1,A2,A3,C7,S7,ZP,CS,CC,CP)="" S (TOC,COM,FTS,COMF,FTSF)=""
32 S A1=$P(Z7,U7,4) S A2=$P(Z7,U7,5) S A3=$P(Z7,U7,9) S PRIMST=$P(Z7,U7,1)
33 S CS=$P(Z7,U7,11) S CC=$P(Z7,U7,12) S CP=$P(Z7,U7,13)
34 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)
35 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)
36 D LSET
37 Q
38LSET ;;;;;;;;;;;;;;;;;;;;;;;;;
39 I A1]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=A1
40 I A2]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=A2
41 I A3]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=A3
42 S:C7="" C7="NO CITY" S:S7="" S7="NO STATE" S:ZP="" ZP="NO ZIP"
43 S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=C7_", "_S7_" "_ZP
44 S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
45 I $G(COM)]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="COMM #: "_COM
46 I $G(ALT)]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="ALT. COMM #: "_ALT
47 I $G(ALT2)]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="ALT. FTS #: "_ALT2
48 I $G(COMF)]""!(FTSF]"") S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="COMM FAX: "_COMF
49 ;;_" FTS FAX: "_FTSF;;EAP LINE BROKEN
50 I $G(PRIMST)]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="PRIM. STATION #: "_PRIMST
51 S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
52 I TOC]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="TITLE OF CHIEF: "_TOC
53 I CS]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="CHIEF'S SUPERVISOR: "_CS
54 I CC]"" S CC=$S(CC=0:"NO",CC=1:"YES",1:"UNK")
55 I CP]"" S CP=$S(CP="O":"OTHER",CP="V":"VISN CHIEF",CP="R":"REPRESENTATIVE",CP="M":"MEMBER AT LARGE",1:"UNK")
56 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
57 S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
58 K C7,S7,ZP,TOC
59 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
60 Q
61SUBSET ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
62 S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
63 S Z2=^ABS(503339.2,J2,2,TT,0) S TLE=$P(Z2,U7,1),NME=$P(Z2,U7,2)
64 I TLE]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="TITLE: "_TLE
65 I NME]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="NAME: "_NME
66 S NICK=$P(Z2,U7,5) I NICK]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="NICKNAME: "_NICK
67 S EOD=$P(Z2,U7,4) S GDE=$P(Z2,U7,3) S SEX=$P(Z2,U7,6) I SEX]"" I SEX=1 S SEX="MALE"
68 I SEX]"" I SEX=2 S SEX="FEMALE"
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_" GENDER: "_SEX
71 I EOD=""&(GDE="") S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="GENDER: "_SEX
72 Q
73STATION ;;;;;;;;;;BEGIN SETTING COL 2 PIECES;;;;;;;;;;;;
74 S FL=0 S COUNT=2
75 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
76 .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
77 .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
78 .I TH]"" S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="SEC STA COMM #: "_FO
79 .I FO]"" S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="SEC STA FTS #: "_TH
80 .I FI]"" S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="SEC STA COMM FAX: "_SI
81 .I SI]"" S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="SEC STA FTS FAX: "_FI
82 .S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)=" "
83 I $D(^ABS(503339.2,J2,4,0)) D
84 . S COUNT=COUNT+1,^TMP("ABSVTMP1",J2,COUNT)=" ",FLG=0 S:FL=0 COUNT=3 S ^TMP("ABSVTMP1",J2,COUNT)="PROGRAMS SUPERVISED: ",N7=0
85 . 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
86 ..S GN=$P(^ABS(503339.2,J2,4,N7,0),U7,1)
87 ..I GN]"",$D(^ABS(503339.3,GN,0)) S GNE=$P(^ABS(503339.3,GN,0),U7,2),COUNT=COUNT+1 S:GN'=1 ^TMP("ABSVTMP1",J2,COUNT)=" "_GNE K GNE S:GN=1 FLG=FLG+1 D
88 ...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: "
89 ...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)
90 ...QUIT
91 ..QUIT
92 .QUIT
93 Q
Note: See TracBrowser for help on using the repository browser.