source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVTED4.m@ 1604

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1ABSVTED4 ;VAMC ALTOONA/CTB - AWARD CODE LOOPING PROGRAM ;4/13/94 11:34 AM
2V ;;4.0;VOLUNTARY TIMEKEEPING;;JULY 6, 1994
3LOOP ;LOOPS THROUGH TIME CARDS FOR 1 MONTH AND ONE STATION NUMBER TO
4 ;ALLOW EDITING OF AWARD CODES. ALLOWS EDITING OF ONLY FIRST CARD
5 ;FOR A PARTICULAR VOLUNTEER IN A MONTH.
6 NEW %,%DT,%W,%Y,ABSVX,C,D,D0,DA,DATE,DI,DIC,DIE,DIR,DQ,DR,DTOUT,DUOUT,DIRUT,DIROUT,I,MONTH,N,NAME,POP,REC,SSN,START,VOLDA,X,Y
7 D ^ABSVSITE Q:'%
8 S %DT="AEQ",%DT("A")="Select Month: " D ^%DT Q:Y<0
9 S DATE=+Y,MONTH=$E(DATE,1,5)_"00"
10 I '$D(^ABS(503335,"AK",MONTH)) S X="There are no time cards on file for "_$$FULLDAT^ABSVU2(MONTH)_". Are you sure you have run the ROLL UP Option? NO further action taken." D MSG^ABSVQ QUIT
11 W !!
12 S X="This option will select only the FIRST card for each volunteer for the month you select. Cards 2 thru 6, if they exist are skipped intentionally to prevent rejects in Austin." D MSG^ABSVQ
13 W !! S X="You may enter an '^' at any point to stop." D MSG^ABSVQ W !!
14DIR S DIR(0)="FAO^1:30^K:X'?.A X",DIR("A")="BEGIN LOOPING WITH VOLUNTEER: FIRST// ",DIR("?")="Enter from 1 to 30 letters, numeric and punctuation prohibited."
15 D ^DIR K DIRUT
16 I +($D(DTOUT)_$D(DUOUT)_$D(DIRUT)_$D(DIROUT)) QUIT
17 I Y="" S Y="A"
18 S START=$$UPPER^ABSVU2(Y)
19 K ^TMP("ABSVAWARD",$J),^TMP("ABSVLIST",$J)
20 D WAIT^ABSVYN
21 S DA=0 F S DA=$O(^ABS(503335,"AK",MONTH,DA)) Q:'DA S REC=^ABS(503335,DA,0) I $P(REC,"^",12)=ABSV("SITE"),+$P(REC,"^",6)=1 D
22 . S VOLDA=+REC,X=$G(^ABS(503330,VOLDA,0)),NAME=$P(X,"^"),SSN=$P(X,"^",2) Q:NAME=""
23 . I '$D(^TMP("ABSVLIST",$J,VOLDA)) S ^TMP("ABSVAWARD",$J,NAME,DA)=SSN,^TMP("ABSVLIST",$J,VOLDA)=""
24 . QUIT
25 I $D(^TMP("ABSVAWARD",$J))<10 S X="There are no time cards on file for "_$$FULLDAT^ABSVU2(MONTH)_" for Station "_ABSV("SITE")_". Are you sure you have run the ROLL UP Option? No further action taken." D MSG^ABSVQ G OUT
26 D WAIT^ABSVYN
27 W !!
28 S DA=0,NAME=START,DR="37AWARD CODE~d",DIE="^ABS(503335,"
29 F S NAME=$O(^TMP("ABSVAWARD",$J,NAME)) Q:NAME="" D I $D(DTOUT) G OUT
30 . S DA=0 F S DA=$O(^TMP("ABSVAWARD",$J,NAME,DA)) Q:'DA D Q:$D(DTOUT)
31 . . W !!,NAME," ",$$EXTSSN^ABSVU2(^TMP("ABSVAWARD",$J,NAME,DA)) D ^DIE
32 . . Q:$D(DTOUT)
33 . . I $D(Y)>9!($D(DUOUT)) S DTOUT="" K DUOUT Q
34 . . QUIT
35 . QUIT
36 QUIT
37 ;
38OUT K ^TMP("ABSVAWARD",$J),^TMP("ABSVLIST",$J)
Note: See TracBrowser for help on using the repository browser.