source: FOIAVistA/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVNIT1.m@ 1106

ABSVNIT1 ;VAMC ALTOONA/CTB_CLH - NIGHTLY BACKROUND JOB ;1/11/01  10:19 AM
V ;;4.0;VOLUNTARY TIMEKEEPING;**7,10,13,15,17,23**;JULY 6, 1994
 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
 I '$D(ABSV("SITE")) D ^ABSVSITE Q:'%
 I '$D(DT) D NOW^%DTC S DT=X
 W ! S ABSVXA="Do you want this transfer to occur each day",ABSVXB="",%=2 D ^ABSVYN
 I %<0 S X="Option Terminated" D MSG^ABSVQ QUIT
 S ABSV("REQUEUE")=$S(%=1:1,1:0)
 K ZTIO,ZTDTH S ABSVQ("FORCEQ")=1,ZTRTN="DQ^ABSVNIT1",ZTSAVE("ABSV*")="",ZTDESC="Post Voluntary Time to Daily Time File" D ^ABSVQ
 K ABSVQ("FORCEQ")
 K %X,%Y Q
DQ L +^ABS("DAILY TRANSFER",ABSV("SITE")):30 I '$T S:$D(ABSV("REQUEUE")) ZTREQ="1H" QUIT
 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
 K WDT,DA,DA1,TH,TDA,ST,QT,ERROR,REC,COMB,NREC,ZZI
 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
 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
 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
 K DA W !! I '$D(ABSVX("ERROR")) W "NO ERRORS FOUND DURING TRANSFER - "_ABSV("SITE")
 W !,KOUNT," RECORDS TRANSFERRED AND DELETED -"_ABSV("SITE"),@IOF
 S N=0,COUNT="",HI="" F I=1:1 S N=$O(^ABS(503330.1,N)) Q:'N  S HI=N,COUNT=I
 S $P(^ABS(503330.1,0),"^",3,4)=HI_"^"_COUNT K HI,N,COUNT,I
 I ABSV("REQUEUE") S ZTREQ=$S($D(ZTDTH):ZTDTH+1_","_$P(ZTDTH,",",2),1:"1D")
 K ABSVX("ERROR"),KOUNT
 L -^ABS("DAILY TRANSFER",ABSV("SITE"))
 QUIT
ERR S $P(^ABS(503330.1,TDA,0),"^",4,5)=X_"^0",ABSVX("ERROR")=1 Q
REMOVE S DIK="^ABS(503330.1," D ^DIK K DIK Q
EN1 I $P(REC,"^",5)]"" S DA=TDA D REMOVE Q
 F I=2,3,7,9 I $P(REC,"^",I)="" S DA=TDA D REMOVE Q
 I $P(REC,"^",9)'=ABSV("SITE") Q
 S COMB=$S($D(^ABS(503330,+REC,1,$P(REC,"^",3),0)):$P(^(0),"^",5),1:"") I COMB="" S X=3 G ERR
 S (SERV,X)=$E(COMB,5,8),Y=$O(^ABS(503332,"B",X,0)) I 'Y S X=4 G ERR
 S SERV=+Y,ORG=+$E(COMB,1,3) I '$D(^ABS(503334,ORG)) S X=5 G ERR
 I '$D(^ABS(503330,+REC,0)) S X=1 G ERR
 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
 S NDA=+Y
 I NDA'>0 S X=^ABS(503331,0),NDA=$P(X,"^",3) F  D  I $D(DONE) K DONE QUIT
 . L +^ABS(503331,0):10 Q:'$T  S NDA=NDA+1
 . Q:$D(^ABS(503331,NDA))["1"  L -^ABS(503331,0)
 . S $P(X,"^",3)=NDA,$P(X,"^",4)=$P(X,"^",4)+1
 . S ^ABS(503331,0)=X
 . L -^ABS(503331,0) S DONE=1
 . QUIT
 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
 S $P(NREC,"^",2)=$E($P(REC,"^",2),1,5)_"00",$P(NREC,"^",9)=1
 S ^ABS(503331,NDA,0)=NREC
 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)=""
 S $P(^ABS(503330.1,TDA,0),"^",5)=1,$P(^(0),"^",8)=COMB
 Q
LIST ;CREATE AND GENERATE CANTEEN LUNCH LIST
 D ^ABSVSITE Q:'%
 S %DT="AEX",%DT("A")="Select Date of Canteen List: " D ^%DT Q:Y<0  S ABSVX("DATE")=Y
 S ZTDESC="Create Volunteer Meal List for Canteen",ZTRTN="L1^ABSVNIT1",ZTSAVE("ABSV*")="" D ^ABSVQ Q
L1 I $D(ZTSK) D KILL^%ZTLOAD
 S $P(LINE,"-",$S($D(IOM):IOM,1:79))="-" S X=ABSVX("DATE") D CNVD^ABSVQ S DATE=Y
 I '$D(DT) D NOW^%DTC S DT=X
 K ^TMP($J) S DA=0 F  S DA=$O(^ABS(503330.2,"AC",ABSVX("DATE"),DA)) Q:'DA  D
 . S ABSVX("NAME")=$P(^ABS(503330.2,DA,0),"^",6)
 . I ABSVX("NAME")="" S X=+$P($G(^ABS(503330.2,DA,0)),"^",1),ABSVX("NAME")=$P($G(^ABS(503330,X,0)),"^",1)
 . I ABSVX("NAME")="" S ABSVX("NAME")="ERROR - IRN "_DA_" VOLDA "_X
 . S ^TMP($J,ABSVX("NAME"),DA)=""
 . QUIT
 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
 I LN<11 S ABSVX("NAME")="",DATE="" F I=LN:1:11 D LINE
 D FTR,PURG1
OUT K NAME,DATE,ABSVX,LN,DA,X Q
PURGE ;PURGE ALL ENTRIES IN FILE 503330.2 OLDER THAT 7 DAYS
 G:$D(ZTQUEUED) PURG1
 S ABSVXA="This option will remove all meal ticket/meal list entries"
 S ABSVXA(1)="from the files which are older than 7 days.",ABSVXA(3)="OK To Continue",ABSVXA(2)="",ABSVXB="",%=1
 D ^ABSVYN I %'=1 S X="<No Action Taken>" D MSG^ABSVQ,OUT QUIT
 W !
 I '$D(ZTQUEUED) D ^ABSVSITE Q:'%
PURG1 S DIK="^ABS(503330.2,"
 S %DT="X",X="T-7" D ^%DT S ABSVX("KDATE")=Y
 S DA=0 F I=1:1 S DA=$O(^ABS(503330.2,DA)) Q:'DA  D
 . Q:'$D(^ABS(503330.2,DA,0))  S X=^(0)
 . Q:+$P(X,"^",4)>ABSVX("KDATE")
 . I '$D(ZTQUEUED) Q:$P(X,"^",2)'=ABSV("SITE")
 . D ^DIK W:'$D(ZTQUEUED) "."
 . QUIT
 D OUT QUIT
LINE I LN>11 D FTR S LN=1
 I LN=1 D HDR
 W !,LN,".",?30,"|",?50,"|",!,ABSVX("NAME"),?30,"|",?35,DATE,?50,"|",!,?30,"|",?50,"|",!,?30,"|",?50,"|",!,LINE S LN=LN+1
 Q
HDR W !,?29,"VETERANS CANTEEN SERVICE",!,?34,"EMPLOYEE MEALS",!,LINE
 W !,?10,"NAME",?30,"|",?38,"DATE",?50,"|",?64,"AMOUNT",!,LINE,!
 Q
FTR W !,"VA FORM  10-5188  (ADP-TEST)  " W:$S('$D(IOSL):1,IOSL>65:1,1:0) ! W "MAY 1977"
 I $D(IOF) W @IOF
 Q
PRINT ;PRINT LIST OF VOLUNTEERS ON MEAL LIST
 D ^ABSVSITE Q:'%
 S %DT="AE",%DT("A")="Select Meal List Date: " D ^%DT Q:Y<0  S DATE=+Y
 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"
 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)"
 D EN1^DIP
 QUIT