source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVTED3.m@ 1005

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1ABSVTED3 ;VAMC ALTOONA/CTB - RESET AND BACKDATE TIME CARDS ;2/10/99 11:59 AM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**7,13**;JULY 6, 1994
3 ;MARK TIME CARD FOR RETRANSMISSION
4 N %,%W,%Y,%Y1,ABSVX,C,CHECK,DDH,DIR,ABSVXX,I,N,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
5 D ^ABSVSITE Q:'%
6 W ! S X="This option will allow you to mark as READY TO TRANSMIT a single time card or all cards for a single month. If a single month is selected, you will be allowed to have each card backdated.*" D MSG^ABSVQ
7 S DIR(0)="S^S:Single Card;A:All Cards for One Month",DIR("A")="Select Marking Option"
8 D ^DIR Q:$$DIR^ABSVU2
9 D @Y
10 Q
11 ;
12S N DIC,Y,X,DA,NAME,%DT,MONTH
13S1 S DIC=503330,DIC(0)="AEMZQ",DIC("S")="I $D(^ABS(503330,+Y,4,ABSV(""INST""),0))"
14 S:'$D(DIC("A")) DIC("A")="Select VOLUNTEER: "
15 F D MDIV^ABSVSITE,^DIC Q:+Y<0 Q:$$ACTIVE^ABSVU2(+Y,ABSV("INST"))
16 K DIC Q:+Y<0
17 S DA=+Y,NAME=$P(Y(0),"^")
18 S %DT="AEP",%DT("A")="Select MONTH/YEAR: " D ^%DT Q:+Y<0
19 S MONTH=$E(Y,1,5)_"00"
20 S DIC="^ABS(503335,",X=NAME,DIC(0)="EMNZQ",DIC("S")="S ZX=^(0) I $P(ZX,U)=DA,$P(ZX,U,5)=MONTH,$P(ZX,U,12)=ABSV(""SITE"")"
21 D ^DIC K ZX
22 I $D(DUOUT) K DUOUT Q
23 I +Y<0 S X="No Timecard on file for "_NAME_", for "_$$FULLDAT^ABSVU2(MONTH)_".*" D MSG^ABSVQ W !! G S1
24 S DA=+Y K DIC
25 I $P(^ABS(503335,DA,0),"^",6)=1 S X=" -- Time Card HAS NOT been transmitted. No Further Action Required --*" D MSG^ABSVQ,RS1 G S1
26 S ABSVXA="Do you want to edit or backdate the time card at this time",ABSVXB="",%=1 D ^ABSVYN Q:%<1
27 I %=1 S ABSVX("MRT")="" D TC1^ABSVTED K ABSVX("MRT")
28 S ABSVXA="Are you sure you want to mark this time card for retransmission",ABSVXB="",%=2 D ^ABSVYN
29 I %'=1 W !,"** NO ACTION TAKEN **"
30 QUIT:%<0
31 I %=2 D RS1 G S1
32 S X=1 D STATUS^ABSVTED
33 D RS1 G S1
34 ;
35RS1 K DIC,Y,X,DA,NAME,%DT,MONTH S DIC("A")="Select Next Volunteer: " Q
36A N %DT,CODE,COUNT,DA,BACKDATE,IDATE,OK,TC,X,X1,XDATE,Y
37 ;INTRO
38SE W ! S X="This option will allow you to reset the transmission status of all time cards for the specified month to 'Ready for Transmission' and 'Backdate' the card.*" D MSG^ABSVQ
39 W !!
40 ;SELECT MONTH
41 D NOW^ABSVQ
42 S %DT="AE",%DT("A")="Select MONTH/YEAR to Mark and Backdate: " D ^%DT
43 Q:Y<0
44 S IDATE=Y,XDATE=$$FULLDAT^ABSVU2(IDATE)
45 I '$D(^ABS(503335,"AK",IDATE)) S X="No Time Cards are on file for that month. <No Action Taken>*" D MSG^ABSVQ QUIT
46 ;'OK'
47 S ABSVXA="Do you also want to backdate the cards",ABSVXB="",%=3 D ^ABSVYN
48 I %<0 S MSG=" <Option Terminated - No Further Action Taken.*" D MSG^ABSVQ QUIT
49 S BACKDATE=$S(%=1:1,1:0)
50 S ABSVXA="I will now loop through ALL time cards for "_XDATE_" and Station "_ABSV("SITE")_","
51 S ABSVXA(1)="then mark each card for tranmission"_$S(BACKDATE:" and backdate.",1:"."),ABSVXA(2)="ARE YOU READY",ABSVXB="" D ^ABSVYN
52 I %'=1 S X=" <No Action Taken>*" D MSG^ABSVQ Q
53 ;LOOP THROUGH
54 I BACKDATE D Q:'OK
55 . S OK=1
56 . S DIC=503337,DIC(0)="M",X="BACKDATE" D ^DIC K DIC
57 . I Y<0 D
58 . . S Y=$O(^ABS(503337,"C","BD",0))
59 . . I Y<0 S OK=1 QUIT
60 . . S X=" Error in file 503337, contact your IRM staff."
61 . . D MSG^ABSVQ
62 . . S OK=0
63 . . QUIT
64 . S BACKDATE=+Y,CODE=$P(^ABS(503337,BACKDATE,0),"^",2)
65 . QUIT
66 W !!
67 S X="I am now beginning the process. Please DO NOT attempt to stop this job.*" D MSG^ABSVQ
68 S DA=0,COUNT=0
69 F S DA=$O(^ABS(503335,"AK",IDATE,DA)) Q:'DA I $D(^ABS(503335,DA,0)) DO
70 . S TC=^ABS(503335,DA,0)
71 . QUIT:'$D(^ABS(503330,$P(TC,"^",1),0))!($P(TC,"^",12)'=ABSV("SITE")) W !,$P(^(0),"^",1)," "
72 . S X1=$P(TC,"^",6) K:X1]"" ^ABS(503335,"AF",X1,DA)
73 . S $P(^ABS(503335,DA,0),"^",6)=1,^ABS(503335,"AF",1,DA)=""
74 . S:BACKDATE $P(^ABS(503335,DA,1),"^",33,34)=BACKDATE_"^"_CODE
75 . W " <Done>"
76 . S COUNT=COUNT+1
77 . QUIT
78 W !!,COUNT," Time Cards for "_XDATE_" have been marked for retransmission "_$S(BACKDATE:"and backdated.",1:".")
79 QUIT
Note: See TracBrowser for help on using the repository browser.