61 lines
3.5 KiB
Mathematica
61 lines
3.5 KiB
Mathematica
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
|