source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVOT.m@ 1305

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

initial load of WorldVistAEHR

File size: 3.5 KB
RevLine 
[613]1ABSVOT ;VAMC ALTOONA/CTB_CLH - TRANSMIT OCCASIONAL HRS TIME SHEET ;7/10/95 3:18 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**6**;JULY 6, 1994
3 N B,DP,ABSVQ,ZTRTN,ZTSAVE,ZTDESC
4 S ABSVXA="This program should ONLY be run during the first six (6) workdays of each month."
5 S ABSVXA(1)="ARE YOU SURE YOU WANT TO CONTINUE",%=2 D ^ABSVYN Q:%'=1
6 W !!
7 D ^ABSVSITE Q:'%
8 S ABSVQ("FORCEQ")="",ZTRTN="QUE^ABSVOT",ZTSAVE("ABSV*")="",ZTDESC="Transmit Voluntary Service Occasional Time Sheets" D ^ABSVQ
9 Q
10QUE ;RELEASE CODE SHEETS TO AUSTIN
11 N CPUJOB
12 S CPUJOB=^%ZOSF("VOL")_"_"_$J
13 I $D(ZTQUEUED) S ZTREQ="@"
14 ;CALCULATE CODE SHEET STRING FOR CODE SHEETS IN CROSS REFERENCE "AF"
15 K ^TMP(CPUJOB,"ABSVOLIST"),^("ABSVOBATCH")
16 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)=""
17 ;PRINT TRANSMISSION LIST AND ERROR LIST
18 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
19 S IOP=ABIOP,DIC="^ABS(503336,",L=0,(FR,TO)="2,"_ABSV("SITE"),(BY,FLDS)="[ABSV OCC ERROR LIST]" D EN1^DIP
20 ;BUILD AND TRANSMIT MESSAGES
21 S KOUNT=0 F ZX=1:1 S KOUNT=$O(^TMP(CPUJOB,"ABSVOBATCH",KOUNT)) Q:'KOUNT D BATCH
22 ;POST TRANSMISSION STATUS AND CLEAN UP ^TMP
23 S DA=0 F I=1:1 S DA=$O(^TMP(CPUJOB,"ABSVOLIST",DA)) Q:'DA D UPDATE
24 K ^TMP(CPUJOB),%,%H,ABSVXI,ABIOP,ABSVX,BATCH,COMB,D1,DA,DIJ,DP,I,J,K,KOUNT,USIO,X,Y,ZTSK,ZX Q
25BATCH ;BUILD INDIVIDUAL MESSAGE
26 S XMDUZ=$S($D(DUZ)#2:DUZ,1:.5),XMSUB="OCCASIONAL VOLUNTEER TIME SHEETS - MESSAGE "_ZX_" OF "_BATCH,XMTEXT="^TMP("""_CPUJOB_""",""ABSVOBATCH"","_KOUNT_","
27 S XMY("XXX@Q-NST.VA.GOV")=""
28 S XMY("G.NST@"_$G(^XMB("NETNAME")))=""
29 D ^XMD
30 W !,XMZ," - Message Filed"
31 Q
32ERROR ;RECORD ERROR ON TIME CARD - RESET TRANSMISSION STATUS TO ERROR
33 S $P(^ABS(503336,DA,0),"^",9)=2,^ABS(503336,"AF",2,DA)="" K ^ABS(503336,"AF",1,DA) D K S %=0 Q
34CREATE ;CREATE TIME CARD STRING FOR CODE SHEET
35 S %=0 G ERROR:'$D(^ABS(503336,DA,0)) S TIMEREC=^(0)
36 G ERROR:'TIMEREC
37 G ERROR:$P(TIMEREC,"^",5)=""
38 S STRING="",TYPE=$P(TIMEREC,"^",2),SITE=$E($P(TIMEREC,"^",3)_" ",1,4)
39 S FILLER=" "
40 S ORG="000"_$P(TIMEREC,"^",4),ORG=$E(ORG,$L(ORG)-2,$L(ORG))
41 S SERV=$E($P(^ABS(503332,$P(TIMEREC,"^",5),0),"^")_" ",1,4)
42 S NUM="00"_$P(TIMEREC,"^",6),NUM=$E(NUM,$L(NUM)-1,$L(NUM))
43 S TOTH="000"_$P(TIMEREC,"^",7),TOTH=$E(TOTH,$L(TOTH)-2,$L(TOTH))
44 S DATE=$E($P(TIMEREC,"^",8),4,7)_$E($P(TIMEREC,"^",8),2,3)
45 S STRING=TYPE_SITE_FILLER_ORG_" "_SERV_NUM_TOTH_DATE_"$"
46 S ^ABS(503336,DA,2)=STRING
47 D K Q
48UPDATE ;UPDATE TRANSMISSION STATUS
49 D NOW^ABSVQ S TIMEREC=^ABS(503336,DA,0),TRANS=$P(TIMEREC,"^",15)
50 I TRANS']"" G X
51 S X1=$P(TIMEREC,"^",9) I X1]"" K ^ABS(503336,"AF",X1,DA)
52 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
53X S X1=$P(TIMEREC,"^",16) I X1]"" K ^ABS(503336,"AD",X1,DA)
54 S X1=$P(TIMEREC,"^",9) I X1]"" K ^ABS(503336,"AF",X1,DA)
55 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
56K K %,ABSVXX,ABSVXY,TYPE,ORG,SERV,NUM,TOTH,DATE,TIMEREC,STRING,SITE S %=1 Q
57PRINT ;PRINT LIST OF QUEUED CODE SHEETS AND SUSPENDED CODE SHEETS
58 D ^ABSVSITE Q:'% D WAIT^ABSVYN
59 S DIC="^ABS(503336,",L=0,FR=ABSV("SITE"),TO=ABSV("SITE")_" ",(BY,FLDS)="[ABSV OCC BATCH LIST]" D EN1^DIP
60 K %X,%Y,ABSVXX,ABSVXY,B,DCC,DIJ,DIOP,DIPT,DP,F,FLDS,L,O,P,W,X,ZTSK Q
Note: See TracBrowser for help on using the repository browser.