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