27 lines
1.1 KiB
Mathematica
27 lines
1.1 KiB
Mathematica
ABSVPPP5 ;EAP ALTOONA SEARCH BY ORGANIZATION CODE ;5/6/98 11:56 AM ; 6/26/97 10:35 AM
|
|
V ;;4.0;VOLUNTARY TIMEKEEPING;**7,10**;JULY 1994;
|
|
S:'$D(IOST) IOST="C-VT100" S U="^"
|
|
S DIC=503334,DIC(0)="AEMNZQ" D ^DIC I +Y<0 G END
|
|
S ABSVORG=+Y S ABSVORGN=$P(^ABS(503334,ABSVORG,0),U,2)
|
|
S ZTRTN="START^ABSVPPP5" S ZTSAVE=("ABSV*")="" D ^ABSVQ
|
|
;S ABSRTN="START^ABSVPPP5" D ^ABSXUTL1 Q
|
|
Q
|
|
START D HDR
|
|
S J=0 F I=1:1 S J=$O(^ABS(503330,J)) Q:'J!(J="") I $D(^ABS(503330,J,0)) S Z=^ABS(503330,J,0) I $D(^ABS(503330,J,1,0)) D
|
|
.S K=0,F=0 F L=1:1 S K=$O(^ABS(503330,J,1,K)) Q:'K!(K="") I $D(^ABS(503330,J,1,K,0)) D SET I ZZ=ABSVORG I F=0 W !,$P(Z,U,1),?35,ABSVCOM,?45,ABSVSCH S F=1 S C=C+1 D:IOST["C"&(C>12) HDR
|
|
END ;;;
|
|
K ABSVSCH,ABSVCOM,C,K,L,ZZ,Z,J,I,ABSVORGN,ABSVORG,DIC,DIC(0),Y
|
|
Q
|
|
HDR S U="^" W:$D(IOF) @IOF
|
|
W !,"VOLUNTEERS WITH ORGANIZATION CODE: ",ABSVORG," ",ABSVORGN
|
|
W !,"NAME",?35,"CODE",?45,"SCHED."
|
|
S:'$D(IOM) IOM=80
|
|
W ! F I=1:1:IOM W "-"
|
|
S C=5
|
|
Q
|
|
SET ;;;;;;;
|
|
S ABSVCOM=$P(^ABS(503330,J,1,K,0),U,1)
|
|
S ZZ=$P(^ABS(503330,J,1,K,0),U,2)
|
|
S ABSVSCH=$P(^ABS(503330,J,1,K,0),U,3) I ABSVSCH]"" I $D(^ABS(503333,ABSVSCH,0)) S ABSVSCH=$P(^ABS(503333,ABSVSCH,0),U,1)
|
|
Q
|