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