source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVGGG2.m@ 1166

Last change on this file since 1166 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1ABSVGGG2 ;EAP ALTOONA ;8/19/97 3:29 PM
2V ;;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
8STARTER ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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
13END ;;;;;;;;;
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
18HEAD ;;;;;;;;;;;;;;;;;;;;;
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
28SUB1 ;;;;;;;;;;;;;;;;;;;;;;;;
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
33SET 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
35IO ;;;;;;;;;;;;;;;;;
36 I $D(IOST) I IOST["C-" S C=C+1
37 Q
38POS1 ;;;;THIS IS A SEPARATE PROGRAM FROM ABOVE
39 ;;;;PRINTOUT CHIEFS & GRADES
40 S ZTRTN="START^ABSVGGG2" D ^ABSVQ
41 Q
42START ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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
46END2 K CNT,ZN,ZN1,ZN2,L,J,I,SITE
47 Q
48SUB 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
50HDR ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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
Note: See TracBrowser for help on using the repository browser.