source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVTED5.m@ 1753

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

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1ABSVTED5 ;VAMC ALTOONA/CTB - BACKDATE LOOP ;11/17/93 8:56 AM
2V ;;4.0;VOLUNTARY TIMEKEEPING;;JULY 6, 1994
3LOOP ;LOOPS THROUGH TIME CARDS FOR 1 MONTH AND ONE STATION NUMBER TO
4 ;STUFF THE BACKDATE
5 ;DOES NOT BACKDATE SUSPENDED TIME CARDS
6 NEW %,%DT,%W,%Y,ABSVX,C,COUNT,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 ABSVXA="This option will select ALL time cards for the month selected which are marked 'READY FOR TRANSMISSION' and will insert a 'BD' into the appropriate columns."
13 S ABSVXA(.5)="",ABSVXA(1)="OK TO CONTINUE",ABSVXB="",%=2
14 D ^ABSVYN I %'=1 S X=" <NO ACTION TAKEN>*" D MSG^ABSVQ QUIT
15 K ^TMP("ABSVAWARD",$J)
16 W !! D WAIT^ABSVYN
17 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
18 . S VOLDA=+REC,X=$G(^ABS(503330,VOLDA,0)),NAME=$P(X,"^"),SSN=$P(X,"^",2) Q:NAME=""
19 . S ^TMP("ABSVAWARD",$J,NAME,DA)=SSN
20 . QUIT
21 I $D(^TMP("ABSVAWARD",$J))<10 S X="There are no time cards which are marked 'Ready For Transmission' for "_$$FULLDAT^ABSVU2(MONTH)_" for Station "_ABSV("SITE")_". No further action taken." D MSG^ABSVQ G OUT
22 W !!
23 S COUNT=0,DA=0,NAME=$G(START),DR="37///BD",DIE="^ABS(503335,"
24 F S NAME=$O(^TMP("ABSVAWARD",$J,NAME)) Q:NAME="" D I $D(DTOUT) G OUT
25 . S DA=0 F S DA=$O(^TMP("ABSVAWARD",$J,NAME,DA)) Q:'DA D Q:$D(DTOUT)
26 . . W !,NAME," ",$$EXTSSN^ABSVU2(^TMP("ABSVAWARD",$J,NAME,DA)) D ^DIE S COUNT=COUNT+1
27 . . QUIT
28 . QUIT
29 W !!,"LOOP COMPLETED - "_COUNT_" RECORDS MARKED"
30 W ! D ENCON^ABSVQ
31 QUIT
32 ;
33OUT K ^TMP("ABSVAWARD",$J),^TMP("ABSVLIST",$J)
Note: See TracBrowser for help on using the repository browser.