94 lines
5.9 KiB
Mathematica
94 lines
5.9 KiB
Mathematica
ABSVPPP2 ;EAP ALTOONA PRINTOUT VOLUNTARY SVC. DIRECTORY ;1/11/01 10:20 AM
|
|
V ;;4.0;VOLUNTARY TIMEKEEPING;**7,23**;JULY 1994;
|
|
DOC ;HARD-CODED PRINTOUT OF FILE 503339.2
|
|
;PROGRAM CREATES 2 TEMPORARY GLOBALS WHICH ARE KILLED AT THE END
|
|
;PROGRAM USES PARAMETER PASSING AND IS CALLED BY FM TEMPLATE
|
|
;[VOLUNTARY SERVICE DIRECTORY] NEEDS PROGRAM ABSVPPP3 TO RUN.
|
|
ONE(J2) ;;;;;;;;;;;;;;
|
|
NEW ;;;;;;;;;;;;;;NEW EVERYTHING EXCEPT J ;;;;;;;;;;;;;;;;;;;;
|
|
N COUNT,EOD,FL,G7,GDE,GN,PAGE,HOLD,CT,LC,ABSVK,ABSVL,ABSVG,ABSVM,ABSVZ,ABSVE,ABSVP
|
|
N CNT,P7,Z7,B1,B2,B3,B4,LL,N7,NICK,NME,TLE,TT,U7,C7,ST,NUM,VS,UP,P7
|
|
N F7,FLG,ABSVY7,A1,A2,A3,C7,S7,ZP,CS,CC,CP,TOC,COM,FTS,COMF,FTSF,Z2,ZN1
|
|
N VAVS,ALT,ALT1
|
|
K ^TMP("ABSVTMP2") K ^TMP("ABSVTMP1")
|
|
S CNT=0 S ^TMP("ABSVTMP2",CNT)="" S U7="^" S P7=0
|
|
I $D(^ABS(503339.2,J2,0)) S CNT=0 S Z7=^ABS(503339.2,J2,0) D HDR D SET D STATION
|
|
PRINTOUT ;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
D ^ABSVPPP3
|
|
END ;;
|
|
K ^TMP("ABSVTMP1")
|
|
K ^TMP("ABSVTMP2")
|
|
K SEX,VAVS,ALT,ALT1,F7,FLG,B1,B2,B3,B4,C7,CNT,J2,Z7,ST,NUM,VS,UP,ABSVY7,P7,PRIMST
|
|
Q
|
|
HDR ;;;;;;;;;;;;SET FIRST LINE OF REPORT;;;;;;;;;;;;;;;;;;;;;;;
|
|
S ST=$P(Z7,U7,2) S NUM=$P(Z7,U7,1) S VS=$P(Z7,U7,3) S UP=$P(Z7,U7,10)
|
|
S P7=P7+1 I UP]"" S ABSVY7=UP D CONVERT1^ABSVPPP3 S UP=ABSVY7
|
|
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
|
|
S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
|
|
;;W !!!,ST,?43,NUM,?50,"VISN #",VS,?62,"DATE OF LAST UPDATE: ",UP,?107,"PAGE: ",P7
|
|
Q
|
|
SET ;;;;;;;;;;;;;;;;;;;;FIX ADDRESS PIECES;;;;;;;;;;;;;;;;;;;;;
|
|
S (A1,A2,A3,C7,S7,ZP,CS,CC,CP)="" S (TOC,COM,FTS,COMF,FTSF)=""
|
|
S A1=$P(Z7,U7,4) S A2=$P(Z7,U7,5) S A3=$P(Z7,U7,9) S PRIMST=$P(Z7,U7,1)
|
|
S CS=$P(Z7,U7,11) S CC=$P(Z7,U7,12) S CP=$P(Z7,U7,13)
|
|
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)
|
|
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)
|
|
D LSET
|
|
Q
|
|
LSET ;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
I A1]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=A1
|
|
I A2]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=A2
|
|
I A3]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=A3
|
|
S:C7="" C7="NO CITY" S:S7="" S7="NO STATE" S:ZP="" ZP="NO ZIP"
|
|
S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=C7_", "_S7_" "_ZP
|
|
S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
|
|
I $G(COM)]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="COMM #: "_COM
|
|
I $G(ALT)]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="ALT. COMM #: "_ALT
|
|
I $G(ALT2)]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="ALT. FTS #: "_ALT2
|
|
I $G(COMF)]""!(FTSF]"") S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="COMM FAX: "_COMF
|
|
;;_" FTS FAX: "_FTSF;;EAP LINE BROKEN
|
|
I $G(PRIMST)]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="PRIM. STATION #: "_PRIMST
|
|
S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
|
|
I TOC]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="TITLE OF CHIEF: "_TOC
|
|
I CS]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="CHIEF'S SUPERVISOR: "_CS
|
|
I CC]"" S CC=$S(CC=0:"NO",CC=1:"YES",1:"UNK")
|
|
I CP]"" S CP=$S(CP="O":"OTHER",CP="V":"VISN CHIEF",CP="R":"REPRESENTATIVE",CP="M":"MEMBER AT LARGE",1:"UNK")
|
|
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
|
|
S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
|
|
K C7,S7,ZP,TOC
|
|
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
|
|
Q
|
|
SUBSET ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)=" "
|
|
S Z2=^ABS(503339.2,J2,2,TT,0) S TLE=$P(Z2,U7,1),NME=$P(Z2,U7,2)
|
|
I TLE]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="TITLE: "_TLE
|
|
I NME]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="NAME: "_NME
|
|
S NICK=$P(Z2,U7,5) I NICK]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="NICKNAME: "_NICK
|
|
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"
|
|
I SEX]"" I SEX=2 S SEX="FEMALE"
|
|
I EOD]"" S ABSVY7=EOD D DATEONLY^ABSVPPP3 S EOD=ABSVY7 K ABSVY7
|
|
I EOD]""!(GDE]"") S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="EOD: "_EOD_" GRADE: "_GDE_" GENDER: "_SEX
|
|
I EOD=""&(GDE="") S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="GENDER: "_SEX
|
|
Q
|
|
STATION ;;;;;;;;;;BEGIN SETTING COL 2 PIECES;;;;;;;;;;;;
|
|
S FL=0 S COUNT=2
|
|
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
|
|
.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
|
|
.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
|
|
.I TH]"" S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="SEC STA COMM #: "_FO
|
|
.I FO]"" S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="SEC STA FTS #: "_TH
|
|
.I FI]"" S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="SEC STA COMM FAX: "_SI
|
|
.I SI]"" S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)="SEC STA FTS FAX: "_FI
|
|
.S COUNT=COUNT+1 S ^TMP("ABSVTMP1",J2,COUNT)=" "
|
|
I $D(^ABS(503339.2,J2,4,0)) D
|
|
. 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
|
|
..S GN=$P(^ABS(503339.2,J2,4,N7,0),U7,1)
|
|
..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
|
|
...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: "
|
|
...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)
|
|
...QUIT
|
|
..QUIT
|
|
.QUIT
|
|
Q
|