source: FOIAVistA/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVOT.m@ 1458

ABSVOT ;VAMC ALTOONA/CTB_CLH - TRANSMIT OCCASIONAL HRS TIME SHEET ;7/10/95  3:18 PM
V ;;4.0;VOLUNTARY TIMEKEEPING;**6**;JULY 6, 1994
 N B,DP,ABSVQ,ZTRTN,ZTSAVE,ZTDESC
 S ABSVXA="This program should ONLY be run during the first six (6) workdays of each month."
 S ABSVXA(1)="ARE YOU SURE YOU WANT TO CONTINUE",%=2 D ^ABSVYN Q:%'=1
 W !!
 D ^ABSVSITE Q:'%
 S ABSVQ("FORCEQ")="",ZTRTN="QUE^ABSVOT",ZTSAVE("ABSV*")="",ZTDESC="Transmit Voluntary Service Occasional Time Sheets" D ^ABSVQ
 Q
QUE ;RELEASE CODE SHEETS TO AUSTIN
 N CPUJOB
 S CPUJOB=^%ZOSF("VOL")_"_"_$J
 I $D(ZTQUEUED) S ZTREQ="@"
 ;CALCULATE CODE SHEET STRING FOR CODE SHEETS IN CROSS REFERENCE "AF"
 K ^TMP(CPUJOB,"ABSVOLIST"),^("ABSVOBATCH")
 S DA=0,(KOUNT,BATCH)=1 F I=1:1 S DA=$O(^ABS(503336,"AF",1,DA)) Q:'DA  I $P(^ABS(503336,DA,0),"^",3)=ABSV("SITE") D CREATE S:%=1 ^TMP(CPUJOB,"ABSVOLIST",DA)=""
 ;PRINT TRANSMISSION LIST AND ERROR LIST
 S IOP=ABIOP,DIC="^ABS(503336,",L=0,(FR,TO)="1,"_ABSV("SITE"),(BY,FLDS)="[ABSV OCC TRANSMIT]",BATCH=1,KOUNT=1 D EN1^DIP
 S IOP=ABIOP,DIC="^ABS(503336,",L=0,(FR,TO)="2,"_ABSV("SITE"),(BY,FLDS)="[ABSV OCC ERROR LIST]" D EN1^DIP
 ;BUILD AND TRANSMIT MESSAGES
 S KOUNT=0 F ZX=1:1 S KOUNT=$O(^TMP(CPUJOB,"ABSVOBATCH",KOUNT)) Q:'KOUNT  D BATCH
 ;POST TRANSMISSION STATUS AND CLEAN UP ^TMP
 S DA=0 F I=1:1 S DA=$O(^TMP(CPUJOB,"ABSVOLIST",DA)) Q:'DA  D UPDATE
 K ^TMP(CPUJOB),%,%H,ABSVXI,ABIOP,ABSVX,BATCH,COMB,D1,DA,DIJ,DP,I,J,K,KOUNT,USIO,X,Y,ZTSK,ZX Q
BATCH ;BUILD INDIVIDUAL MESSAGE
 S XMDUZ=$S($D(DUZ)#2:DUZ,1:.5),XMSUB="OCCASIONAL VOLUNTEER TIME SHEETS - MESSAGE "_ZX_" OF "_BATCH,XMTEXT="^TMP("""_CPUJOB_""",""ABSVOBATCH"","_KOUNT_","
 S XMY("XXX@Q-NST.VA.GOV")=""
 S XMY("G.NST@"_$G(^XMB("NETNAME")))=""
 D ^XMD
 W !,XMZ," - Message Filed"
 Q
ERROR ;RECORD ERROR ON TIME CARD - RESET TRANSMISSION STATUS TO ERROR
 S $P(^ABS(503336,DA,0),"^",9)=2,^ABS(503336,"AF",2,DA)="" K ^ABS(503336,"AF",1,DA) D K S %=0 Q
CREATE ;CREATE TIME CARD STRING FOR CODE SHEET
 S %=0 G ERROR:'$D(^ABS(503336,DA,0)) S TIMEREC=^(0)
 G ERROR:'TIMEREC
 G ERROR:$P(TIMEREC,"^",5)=""
 S STRING="",TYPE=$P(TIMEREC,"^",2),SITE=$E($P(TIMEREC,"^",3)_"    ",1,4)
 S FILLER="          "
 S ORG="000"_$P(TIMEREC,"^",4),ORG=$E(ORG,$L(ORG)-2,$L(ORG))
 S SERV=$E($P(^ABS(503332,$P(TIMEREC,"^",5),0),"^")_"    ",1,4)
 S NUM="00"_$P(TIMEREC,"^",6),NUM=$E(NUM,$L(NUM)-1,$L(NUM))
 S TOTH="000"_$P(TIMEREC,"^",7),TOTH=$E(TOTH,$L(TOTH)-2,$L(TOTH))
 S DATE=$E($P(TIMEREC,"^",8),4,7)_$E($P(TIMEREC,"^",8),2,3)
 S STRING=TYPE_SITE_FILLER_ORG_" "_SERV_NUM_TOTH_DATE_"$"
 S ^ABS(503336,DA,2)=STRING
 D K Q
UPDATE ;UPDATE TRANSMISSION STATUS
 D NOW^ABSVQ S TIMEREC=^ABS(503336,DA,0),TRANS=$P(TIMEREC,"^",15)
 I TRANS']"" G X
 S X1=$P(TIMEREC,"^",9) I X1]"" K ^ABS(503336,"AF",X1,DA)
 S X1=$E(X,1,5)_"00",$P(TIMEREC,"^",15,16)=X_"^"_X1,$P(TIMEREC,"^",11)=DUZ,$P(TIMEREC,"^",9)=3,^ABS(503336,DA,0)=TIMEREC,^ABS(503336,"AF",3,DA)="",^ABS(503336,"AD",X1,DA)="" K X1 G K
X S X1=$P(TIMEREC,"^",16) I X1]"" K ^ABS(503336,"AD",X1,DA)
 S X1=$P(TIMEREC,"^",9) I X1]"" K ^ABS(503336,"AF",X1,DA)
 S $P(TIMEREC,"^",12,13)=X_"^"_DUZ,$P(TIMEREC,"^",9)=4,X1=$E(X,1,5)_"00",$P(TIMEREC,"^",16)=X1,^ABS(503336,DA,0)=TIMEREC,^ABS(503336,"AD",X1,DA)="",^ABS(503336,"AF",4,DA)="" K X1
K K %,ABSVXX,ABSVXY,TYPE,ORG,SERV,NUM,TOTH,DATE,TIMEREC,STRING,SITE S %=1 Q
PRINT ;PRINT LIST OF QUEUED CODE SHEETS AND SUSPENDED CODE SHEETS
 D ^ABSVSITE Q:'%  D WAIT^ABSVYN
 S DIC="^ABS(503336,",L=0,FR=ABSV("SITE"),TO=ABSV("SITE")_" ",(BY,FLDS)="[ABSV OCC BATCH LIST]" D EN1^DIP
 K %X,%Y,ABSVXX,ABSVXY,B,DCC,DIJ,DIOP,DIPT,DP,F,FLDS,L,O,P,W,X,ZTSK Q