source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVPPP5.m@ 1801

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

initial load of WorldVistAEHR

File size: 1.1 KB
Line 
1ABSVPPP5 ;EAP ALTOONA SEARCH BY ORGANIZATION CODE ;5/6/98 11:56 AM ; 6/26/97 10:35 AM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**7,10**;JULY 1994;
3 S:'$D(IOST) IOST="C-VT100" S U="^"
4 S DIC=503334,DIC(0)="AEMNZQ" D ^DIC I +Y<0 G END
5 S ABSVORG=+Y S ABSVORGN=$P(^ABS(503334,ABSVORG,0),U,2)
6 S ZTRTN="START^ABSVPPP5" S ZTSAVE=("ABSV*")="" D ^ABSVQ
7 ;S ABSRTN="START^ABSVPPP5" D ^ABSXUTL1 Q
8 Q
9START D HDR
10 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
11 .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
12END ;;;
13 K ABSVSCH,ABSVCOM,C,K,L,ZZ,Z,J,I,ABSVORGN,ABSVORG,DIC,DIC(0),Y
14 Q
15HDR S U="^" W:$D(IOF) @IOF
16 W !,"VOLUNTEERS WITH ORGANIZATION CODE: ",ABSVORG," ",ABSVORGN
17 W !,"NAME",?35,"CODE",?45,"SCHED."
18 S:'$D(IOM) IOM=80
19 W ! F I=1:1:IOM W "-"
20 S C=5
21 Q
22SET ;;;;;;;
23 S ABSVCOM=$P(^ABS(503330,J,1,K,0),U,1)
24 S ZZ=$P(^ABS(503330,J,1,K,0),U,2)
25 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)
26 Q
Note: See TracBrowser for help on using the repository browser.