source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVNIT1.m@ 1042

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1ABSVNIT1 ;VAMC ALTOONA/CTB_CLH - NIGHTLY BACKROUND JOB ;1/11/01 10:19 AM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**7,10,13,15,17,23**;JULY 6, 1994
3 I '$D(^ABS(503331,0)) W !!,"DAILY TIME RECORD FILE HAS NOT BEEN DEFINED. CALL SITE MANAGER",# K REC,ST,TH,QT,DA,ERROR Q
4 I '$D(ABSV("SITE")) D ^ABSVSITE Q:'%
5 I '$D(DT) D NOW^%DTC S DT=X
6 W ! S ABSVXA="Do you want this transfer to occur each day",ABSVXB="",%=2 D ^ABSVYN
7 I %<0 S X="Option Terminated" D MSG^ABSVQ QUIT
8 S ABSV("REQUEUE")=$S(%=1:1,1:0)
9 K ZTIO,ZTDTH S ABSVQ("FORCEQ")=1,ZTRTN="DQ^ABSVNIT1",ZTSAVE("ABSV*")="",ZTDESC="Post Voluntary Time to Daily Time File" D ^ABSVQ
10 K ABSVQ("FORCEQ")
11 K %X,%Y Q
12DQ L +^ABS("DAILY TRANSFER",ABSV("SITE")):30 I '$T S:$D(ABSV("REQUEUE")) ZTREQ="1H" QUIT
13 S TDA=0 F ZZI=1:1 S TDA=$O(^ABS(503330.1,TDA)) Q:'TDA I $D(^(TDA,0)) S REC=^(0),WDT=$P(REC,"^",2) D EN1
14 K WDT,DA,DA1,TH,TDA,ST,QT,ERROR,REC,COMB,NREC,ZZI
15 S IOP=ABIOP,DIC="^ABS(503330.1,",L=0,FR=ABSV("SITE"),TO=ABSV("SITE")_" ",BY="[ABSV POST SORT]",FLDS="[ABSV POST PRINT]",DHD="VOLUNTEER AUTOMATIC LOG-IN TRANSFER RECORD - "_ABSV("SITE") D EN1^DIP K DIC,BY,FLDS,L
16 I $D(ABSVX("ERROR")) S IOP=ABIOP,DIC="^ABS(503330.1,",L=0,(FR,TO)=ABSV("SITE"),BY="[ABSV POST ERROR]",FLDS="[ABSV POST ERROR PRINT]",DHD="POST DAILY TIME ENTRY ERROR LISTING - "_ABSV("SITE") D EN1^DIP K DIC,BY,FLDS,L
17 S KOUNT=0,DA=0,DIK="^ABS(503330.1," F ZZI=1:1 S DA=$O(^ABS(503330.1,DA)) Q:'DA I $D(^(DA,0)),$P(^(0),"^",5)]"",$P(^(0),"^",9)=ABSV("SITE") D ^DIK S KOUNT=KOUNT+1
18 K DA W !! I '$D(ABSVX("ERROR")) W "NO ERRORS FOUND DURING TRANSFER - "_ABSV("SITE")
19 W !,KOUNT," RECORDS TRANSFERRED AND DELETED -"_ABSV("SITE"),@IOF
20 S N=0,COUNT="",HI="" F I=1:1 S N=$O(^ABS(503330.1,N)) Q:'N S HI=N,COUNT=I
21 S $P(^ABS(503330.1,0),"^",3,4)=HI_"^"_COUNT K HI,N,COUNT,I
22 I ABSV("REQUEUE") S ZTREQ=$S($D(ZTDTH):ZTDTH+1_","_$P(ZTDTH,",",2),1:"1D")
23 K ABSVX("ERROR"),KOUNT
24 L -^ABS("DAILY TRANSFER",ABSV("SITE"))
25 QUIT
26ERR S $P(^ABS(503330.1,TDA,0),"^",4,5)=X_"^0",ABSVX("ERROR")=1 Q
27REMOVE S DIK="^ABS(503330.1," D ^DIK K DIK Q
28EN1 I $P(REC,"^",5)]"" S DA=TDA D REMOVE Q
29 F I=2,3,7,9 I $P(REC,"^",I)="" S DA=TDA D REMOVE Q
30 I $P(REC,"^",9)'=ABSV("SITE") Q
31 S COMB=$S($D(^ABS(503330,+REC,1,$P(REC,"^",3),0)):$P(^(0),"^",5),1:"") I COMB="" S X=3 G ERR
32 S (SERV,X)=$E(COMB,5,8),Y=$O(^ABS(503332,"B",X,0)) I 'Y S X=4 G ERR
33 S SERV=+Y,ORG=+$E(COMB,1,3) I '$D(^ABS(503334,ORG)) S X=5 G ERR
34 I '$D(^ABS(503330,+REC,0)) S X=1 G ERR
35 S Y=0 F S Y=$O(^ABS(503331,"B",+REC,Y)) Q:Y="" S X=$G(^ABS(503331,Y,0)) I $P(X,"^",3)=WDT,$P(X,"^",6)=COMB QUIT
36 S NDA=+Y
37 I NDA'>0 S X=^ABS(503331,0),NDA=$P(X,"^",3) F D I $D(DONE) K DONE QUIT
38 . L +^ABS(503331,0):10 Q:'$T S NDA=NDA+1
39 . Q:$D(^ABS(503331,NDA))["1" L -^ABS(503331,0)
40 . S $P(X,"^",3)=NDA,$P(X,"^",4)=$P(X,"^",4)+1
41 . S ^ABS(503331,0)=X
42 . L -^ABS(503331,0) S DONE=1
43 . QUIT
44 S $P(NREC,"^",1)=$P(REC,"^",1),$P(NREC,"^",7)=ABSV("SITE"),$P(NREC,"^",3)=$P(REC,"^",2),$P(NREC,"^",4)=ORG,$P(NREC,"^",8)=SERV,$P(NREC,"^",5)=$P(REC,"^",7),$P(NREC,"^",6)=COMB
45 S $P(NREC,"^",2)=$E($P(REC,"^",2),1,5)_"00",$P(NREC,"^",9)=1
46 S ^ABS(503331,NDA,0)=NREC
47 S ^ABS(503331,"B",$P(NREC,"^",1),NDA)="",^ABS(503331,"AD",$P(NREC,"^",3),NDA)="",^ABS(503331,"AC",$P(NREC,"^",4),NDA)="",^ABS(503331,"AE",SERV,NDA)="",^ABS(503331,"AF",$P(NREC,"^",2),NDA)="",^ABS(503331,"AH",1,NDA)=""
48 S $P(^ABS(503330.1,TDA,0),"^",5)=1,$P(^(0),"^",8)=COMB
49 Q
50LIST ;CREATE AND GENERATE CANTEEN LUNCH LIST
51 D ^ABSVSITE Q:'%
52 S %DT="AEX",%DT("A")="Select Date of Canteen List: " D ^%DT Q:Y<0 S ABSVX("DATE")=Y
53 S ZTDESC="Create Volunteer Meal List for Canteen",ZTRTN="L1^ABSVNIT1",ZTSAVE("ABSV*")="" D ^ABSVQ Q
54L1 I $D(ZTSK) D KILL^%ZTLOAD
55 S $P(LINE,"-",$S($D(IOM):IOM,1:79))="-" S X=ABSVX("DATE") D CNVD^ABSVQ S DATE=Y
56 I '$D(DT) D NOW^%DTC S DT=X
57 K ^TMP($J) S DA=0 F S DA=$O(^ABS(503330.2,"AC",ABSVX("DATE"),DA)) Q:'DA D
58 . S ABSVX("NAME")=$P(^ABS(503330.2,DA,0),"^",6)
59 . I ABSVX("NAME")="" S X=+$P($G(^ABS(503330.2,DA,0)),"^",1),ABSVX("NAME")=$P($G(^ABS(503330,X,0)),"^",1)
60 . I ABSVX("NAME")="" S ABSVX("NAME")="ERROR - IRN "_DA_" VOLDA "_X
61 . S ^TMP($J,ABSVX("NAME"),DA)=""
62 . QUIT
63 S LN=1,ABSVX("NAME")="" F S ABSVX("NAME")=$O(^TMP($J,ABSVX("NAME"))) Q:ABSVX("NAME")="" S DA=0 F S DA=$O(^TMP($J,ABSVX("NAME"),DA)) Q:'DA S X=^ABS(503330.2,DA,0) I $P(X,"^",2)=ABSV("SITE") D LINE
64 I LN<11 S ABSVX("NAME")="",DATE="" F I=LN:1:11 D LINE
65 D FTR,PURG1
66OUT K NAME,DATE,ABSVX,LN,DA,X Q
67PURGE ;PURGE ALL ENTRIES IN FILE 503330.2 OLDER THAT 7 DAYS
68 G:$D(ZTQUEUED) PURG1
69 S ABSVXA="This option will remove all meal ticket/meal list entries"
70 S ABSVXA(1)="from the files which are older than 7 days.",ABSVXA(3)="OK To Continue",ABSVXA(2)="",ABSVXB="",%=1
71 D ^ABSVYN I %'=1 S X="<No Action Taken>" D MSG^ABSVQ,OUT QUIT
72 W !
73 I '$D(ZTQUEUED) D ^ABSVSITE Q:'%
74PURG1 S DIK="^ABS(503330.2,"
75 S %DT="X",X="T-7" D ^%DT S ABSVX("KDATE")=Y
76 S DA=0 F I=1:1 S DA=$O(^ABS(503330.2,DA)) Q:'DA D
77 . Q:'$D(^ABS(503330.2,DA,0)) S X=^(0)
78 . Q:+$P(X,"^",4)>ABSVX("KDATE")
79 . I '$D(ZTQUEUED) Q:$P(X,"^",2)'=ABSV("SITE")
80 . D ^DIK W:'$D(ZTQUEUED) "."
81 . QUIT
82 D OUT QUIT
83LINE I LN>11 D FTR S LN=1
84 I LN=1 D HDR
85 W !,LN,".",?30,"|",?50,"|",!,ABSVX("NAME"),?30,"|",?35,DATE,?50,"|",!,?30,"|",?50,"|",!,?30,"|",?50,"|",!,LINE S LN=LN+1
86 Q
87HDR W !,?29,"VETERANS CANTEEN SERVICE",!,?34,"EMPLOYEE MEALS",!,LINE
88 W !,?10,"NAME",?30,"|",?38,"DATE",?50,"|",?64,"AMOUNT",!,LINE,!
89 Q
90FTR W !,"VA FORM 10-5188 (ADP-TEST) " W:$S('$D(IOSL):1,IOSL>65:1,1:0) ! W "MAY 1977"
91 I $D(IOF) W @IOF
92 Q
93PRINT ;PRINT LIST OF VOLUNTEERS ON MEAL LIST
94 D ^ABSVSITE Q:'%
95 S %DT="AE",%DT("A")="Select Meal List Date: " D ^%DT Q:Y<0 S DATE=+Y
96 S DIC="^ABS(503330.2,",DIS(0)="I $P(^ABS(503330.2,D0,0),U,2)=ABSV(""SITE"")",L=0,BY="[ABSV MEAL PRINT]",(FR,TO)=DATE,FLDS=".01"
97 S DHD="VOLUNTEER MEAL LIST FOR "_$$FULLDAT^ABSVU2(DATE),DIOBEG="S COUNT=0",DHIT="S COUNT=$G(COUNT)+1",DIOEND="W !,""Total Records on List: "",+$G(COUNT)"
98 D EN1^DIP
99 QUIT
Note: See TracBrowser for help on using the repository browser.