source: FOIAVistA/tag/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVPPP4.m@ 628

ABSVPPP4 ;EAP ALTOONA  PRINTOUT VOLUNTARY SVC. DIRECTORY  ;9/24/97  4:41 PM
V ;;4.0;VOLUNTARY TIMEKEEPING;**7**;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 ABSVPPP5 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
KILL ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 K ^TMP($J,"ABSV") K ^TMP($J,"ABSV1")
 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 ;;;;;;;;;;;;;;;;;;;;;;;;;;
 H 1 D ^ABSVPPP5
END ;;
 H 1 K ^TMP("ABSVTMP1")
 K ^TMP("ABSVTMP2")
 K VAVS,ALT,ALT1,F7,FLG,B1,B2,B3,B4,C7,CNT,J2,Z7,ST,NUM,VS,UP,ABSVY7,P7
 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 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 COM]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="COMM #: "_COM
 I ALT]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="ALT. COMM #: "_ALT
 I FTS]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="FTS #: "_FTS
 I ALT2]"" S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="ALT. FTS #: "_ALT2
 I COMF]""!(FTSF]"") S CNT=CNT+1 S ^TMP("ABSVTMP2",J2,CNT)="COMM FAX: "_COMF_"   FTS FAX: "_FTSF
 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)
 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
 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)) 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]"" 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
 ..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)
 Q