| [613] | 1 | ABSVGGG2 ;EAP ALTOONA ;8/19/97 3:29 PM
|
|---|
| 2 | V ;;4.0;VOLUNTARY TIMEKEEPING;**7**;JULY 1994;
|
|---|
| 3 | N NUM
|
|---|
| 4 | S DIC=503339.3,DIC(0)="MNZQEA",DIC("A")="SELECT a Program// " D ^DIC G:Y<0 END
|
|---|
| 5 | S NUM=+Y K X,Y,Y(0),Y(0,0),%,C
|
|---|
| 6 | S ZTSAVE("NUM")="" S ZTRTN="STARTER^ABSVGGG2" D ^ABSVQ
|
|---|
| 7 | Q
|
|---|
| 8 | STARTER ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 9 | N PAGE,LC,P,J,I,MS,C,F,VA,NM,VAMC,PROG,VAL,K,L,NAM
|
|---|
| 10 | N HDR,%,Y,X
|
|---|
| 11 | S PAGE=0 S NAM="" I $D(^ABS(503339.3,NUM,0)) S NAM=$P(^ABS(503339.3,NUM,0),"^",1) S PROG=$P(^ABS(503339.3,NUM,0),"^",2) D HEAD
|
|---|
| 12 | S J=0 F I=1:1 S J=$O(^ABS(503339.2,J)) Q:'J!(J="") I $D(^ABS(503339.2,J,4,0)) S K=0 F L=1:1 S K=$O(^ABS(503339.2,J,4,K)) Q:'K!(K="") S VAL=+$P(^ABS(503339.2,J,4,K,0),"^",1) D SUB1 I C>20 W !,MS R X:300 G:X="^" END D HEAD
|
|---|
| 13 | END ;;;;;;;;;
|
|---|
| 14 | K PAGE,LC,P,J,I,MS,C,F,VA,NM,VAMC,PROG,VAL,K,L,NAM,NUM,DIC,DIC(0),DIC("A")
|
|---|
| 15 | K HDR,DISYS,V,%,Y,Y(0),Y(0,0),X
|
|---|
| 16 | K ABSV("INST"),ABSV("SITE"),ABSV("SITENAME"),ABSV("PARAM"),ABSV("PER")
|
|---|
| 17 | Q
|
|---|
| 18 | HEAD ;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 19 | I $D(IOF) W @IOF
|
|---|
| 20 | I '$D(IOM) S IOM=79
|
|---|
| 21 | S HDR="STATIONS PROVIDING "_PROG
|
|---|
| 22 | S PAGE=PAGE+1
|
|---|
| 23 | W !,?IOM-$L(HDR)\2,HDR
|
|---|
| 24 | W !,"ST# SITE",?36,"CHIEF",?60,"PHONE",?72,"PAGE: ",PAGE
|
|---|
| 25 | W ! F I=1:1:IOM W "="
|
|---|
| 26 | S C=4 S LC=4 S MS="Press Return to Continue..."
|
|---|
| 27 | Q
|
|---|
| 28 | SUB1 ;;;;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 29 | I '$D(^ABS(503339.3,VAL,0)) Q
|
|---|
| 30 | I $D(^ABS(503339.2,J,1)) S P=$P(^ABS(503339.2,J,1),"^",3)
|
|---|
| 31 | S F=$P(^ABS(503339.3,VAL,0),"^",1) I F=NAM S VA=$P(^ABS(503339.2,J,0),"^",2) S V=$P(^ABS(503339.2,J,0),"^",1) S NM="" I $D(^ABS(503339.2,J,2,1,0)) S NM=$P(^ABS(503339.2,J,2,1,0),"^",2) D SET W !,V,?6,VA,?36,NM,?60,P D IO
|
|---|
| 32 | Q
|
|---|
| 33 | SET S LC=LC+1 S NM=$E(NM,1,25) S VA=$E(VA,1,25) I IOST["P-" I LC>60 D HEAD
|
|---|
| 34 | Q
|
|---|
| 35 | IO ;;;;;;;;;;;;;;;;;
|
|---|
| 36 | I $D(IOST) I IOST["C-" S C=C+1
|
|---|
| 37 | Q
|
|---|
| 38 | POS1 ;;;;THIS IS A SEPARATE PROGRAM FROM ABOVE
|
|---|
| 39 | ;;;;PRINTOUT CHIEFS & GRADES
|
|---|
| 40 | S ZTRTN="START^ABSVGGG2" D ^ABSVQ
|
|---|
| 41 | Q
|
|---|
| 42 | START ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 43 | ;NAME OF PERSON IN POSITION 1 OF MULTIPLE FIELD;
|
|---|
| 44 | D HDR
|
|---|
| 45 | S J=0 F I=1:1 S J=$O(^ABS(503339.2,J)) Q:'J!(J="") I $D(^ABS(503339.2,J,0)) S SITE=$P(^ABS(503339.2,J,0),"^",2) D SUB I CNT>18 W !,"Press Return to Continue..." R X:300 G:X="^" END2 D HDR
|
|---|
| 46 | END2 K CNT,ZN,ZN1,ZN2,L,J,I,SITE
|
|---|
| 47 | Q
|
|---|
| 48 | SUB I $D(^ABS(503339.2,J,2,1,0)) S ZN=^ABS(503339.2,J,2,1,0) S ZN1=$P(ZN,"^",2) S ZN2=$P(ZN,"^",3) W !,SITE,?40,ZN1,?68,ZN2 I $D(IOST) I IOST["C-" S CNT=CNT+1
|
|---|
| 49 | Q
|
|---|
| 50 | HDR ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|---|
| 51 | I $D(IOF) W @IOF
|
|---|
| 52 | W !,"VOLUNTARY CHIEF LISTING"
|
|---|
| 53 | W !,"SITE",?40,"CHIEF",?68,"GRADE"
|
|---|
| 54 | I '$D(IOM) S IOM=79
|
|---|
| 55 | S CNT=4 W ! F L=1:1:IOM W "="
|
|---|
| 56 | Q
|
|---|
