57 lines
2.4 KiB
Mathematica
57 lines
2.4 KiB
Mathematica
ABSVGGG2 ;EAP ALTOONA ;8/19/97 3:29 PM
|
|
V ;;4.0;VOLUNTARY TIMEKEEPING;**7**;JULY 1994;
|
|
N NUM
|
|
S DIC=503339.3,DIC(0)="MNZQEA",DIC("A")="SELECT a Program// " D ^DIC G:Y<0 END
|
|
S NUM=+Y K X,Y,Y(0),Y(0,0),%,C
|
|
S ZTSAVE("NUM")="" S ZTRTN="STARTER^ABSVGGG2" D ^ABSVQ
|
|
Q
|
|
STARTER ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
N PAGE,LC,P,J,I,MS,C,F,VA,NM,VAMC,PROG,VAL,K,L,NAM
|
|
N HDR,%,Y,X
|
|
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
|
|
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
|
|
END ;;;;;;;;;
|
|
K PAGE,LC,P,J,I,MS,C,F,VA,NM,VAMC,PROG,VAL,K,L,NAM,NUM,DIC,DIC(0),DIC("A")
|
|
K HDR,DISYS,V,%,Y,Y(0),Y(0,0),X
|
|
K ABSV("INST"),ABSV("SITE"),ABSV("SITENAME"),ABSV("PARAM"),ABSV("PER")
|
|
Q
|
|
HEAD ;;;;;;;;;;;;;;;;;;;;;
|
|
I $D(IOF) W @IOF
|
|
I '$D(IOM) S IOM=79
|
|
S HDR="STATIONS PROVIDING "_PROG
|
|
S PAGE=PAGE+1
|
|
W !,?IOM-$L(HDR)\2,HDR
|
|
W !,"ST# SITE",?36,"CHIEF",?60,"PHONE",?72,"PAGE: ",PAGE
|
|
W ! F I=1:1:IOM W "="
|
|
S C=4 S LC=4 S MS="Press Return to Continue..."
|
|
Q
|
|
SUB1 ;;;;;;;;;;;;;;;;;;;;;;;;
|
|
I '$D(^ABS(503339.3,VAL,0)) Q
|
|
I $D(^ABS(503339.2,J,1)) S P=$P(^ABS(503339.2,J,1),"^",3)
|
|
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
|
|
Q
|
|
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
|
|
Q
|
|
IO ;;;;;;;;;;;;;;;;;
|
|
I $D(IOST) I IOST["C-" S C=C+1
|
|
Q
|
|
POS1 ;;;;THIS IS A SEPARATE PROGRAM FROM ABOVE
|
|
;;;;PRINTOUT CHIEFS & GRADES
|
|
S ZTRTN="START^ABSVGGG2" D ^ABSVQ
|
|
Q
|
|
START ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;NAME OF PERSON IN POSITION 1 OF MULTIPLE FIELD;
|
|
D HDR
|
|
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
|
|
END2 K CNT,ZN,ZN1,ZN2,L,J,I,SITE
|
|
Q
|
|
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
|
|
Q
|
|
HDR ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
I $D(IOF) W @IOF
|
|
W !,"VOLUNTARY CHIEF LISTING"
|
|
W !,"SITE",?40,"CHIEF",?68,"GRADE"
|
|
I '$D(IOM) S IOM=79
|
|
S CNT=4 W ! F L=1:1:IOM W "="
|
|
Q
|