source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVPPP3.m@ 1639

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1ABSVPPP3 ;EAP ALTOONA ;9/19/97 4:33 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**7**;JULY 1994;
3DOC ;CALLED BY PROGRAM ABSVPPP2. USES PARAMETER PASSING
4INIT Q:'$D(^TMP("ABSVTMP2"))
5 Q:'$D(^TMP("ABSVTMP1"))
6 S U7="^" S:'$D(IOSL) IOSL=64
7 S ABSVK=0 F ABSVL=1:1 S ABSVK=$O(^TMP("ABSVTMP2",ABSVK)) Q:'ABSVK!(ABSVK="") S CT=0 S ABSVG=0 F ABSVM=1:1 S ABSVG=$O(^TMP("ABSVTMP2",ABSVK,ABSVG)) D:'ABSVG!(ABSVG="") OUT Q:'ABSVG!(ABSVG="") I $D(^TMP("ABSVTMP2",ABSVK,ABSVG)) S CT=CT+1 D
8 .S ABSVZ=^TMP("ABSVTMP2",ABSVK,ABSVG) D:ABSVG=1 HDR D:LC=IOSL HDR W:ABSVG>1 !,?9,ABSVZ S LC=LC+1 I ABSVG>2 I $D(^TMP("ABSVTMP1",ABSVK,ABSVG)) W ?69,"| ",^TMP("ABSVTMP1",ABSVK,ABSVG)
9END ;;;;;;;;;;;;;;;
10 K ABSVY7,U7,PAGE,ABSVL,ABSVK,CT,ABSVG,ABSVM,ABSVZ,ABSVP,ABSVF,ABSVE,LC,ABSVLINE
11 Q
12HDR ;;;;;;;;;;;;;;;;
13 I ABSVG=1 S HOLD=ABSVZ
14 S LC=0 K ABSVLINE S $P(ABSVLINE,"=",IOM)=""
15 W #,!,ABSVLINE
16 I ABSVG=1 S B1=$P(HOLD,U7,1) S B2=$P(HOLD,U7,2) S B3=$P(HOLD,U7,3)
17 I ABSVG>1 S B1=$P(HOLD,U7,1),B2="** CONTINUATION **",B3=""
18 W !,?23,B1,?59,B2,?71,B3,!,ABSVLINE,!
19 S LC=LC+5
20 Q
21OUT ;;IF RIGHT HAND COLUMN IS GREATER THAN LEFT HAND COL, PRINT IT!
22 S ABSVF=0 F ABSVE=1:1 S ABSVF=$O(^TMP("ABSVTMP1",ABSVK,ABSVF)) Q:'ABSVF!(ABSVF="") I $D(^TMP("ABSVTMP1",ABSVK,ABSVF)) I ABSVF>CT W !,?69,"| ",^TMP("ABSVTMP1",ABSVK,ABSVF)
23 Q
24DATEONLY ;;
25 S:ABSVY7 ABSVY7=$P($$FULLDAT^ABSVU2(ABSVY7),"@",1)
26 QUIT
27CONVERT1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 S:ABSVY7 ABSVY7=$$FULLDAT^ABSVU2(ABSVY7) QUIT
29 QUIT
Note: See TracBrowser for help on using the repository browser.