source: WorldVistAEHR/trunk/r/VOLUNTARY_TIMEKEEPING-ABSV/ABSVT.m@ 1579

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

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
[613]1ABSVT ;VAMC ALTOONA/CTB - TRANSMIT VOL CODE SHEETS TO AUSTIN ;7/10/95 3:09 PM
2V ;;4.0;VOLUNTARY TIMEKEEPING;**6**;JULY 6, 1994
3 S ABSVXA="This program should ONLY be run during the first six (6) workdays of each month."
4 S ABSVXA(1)="ARE YOU SURE YOU WANT TO CONTINUE",%=2 D ^ABSVYN Q:%'=1
5 W !!
6 D ^ABSVSITE Q:'%
7 S ABSVQ("FORCEQ")="",ZTRTN="QUE^ABSVT",ZTSAVE("ABSV*")="",ZTDESC="Transmit Voluntary Service Code Sheets" D ^ABSVQ
8 Q
9QUE ;RELEASE CODE SHEETS TO AUSTIN
10 N CPUJOB
11 S CPUJOB=^%ZOSF("VOL")_"_"_$J
12 S BATCH=3
13 I $D(ZTQUEUED) D KILL^%ZTLOAD
14 ;CALCULATE CODE SHEET STRING FOR CODE SHEETS IN CROSS REFERENCE "AF"
15 K ^TMP(CPUJOB,"ABSVLIST"),^("ABSVBATCH")
16 K ^ABS(503335,"AF",1,-1) ; KILLS BAD CROSS REFERENCE IF IT EXISTS
17 S DA=0,(KOUNT,BATCH)=1 F I=1:1 S DA=$O(^ABS(503335,"AF",1,DA)) Q:'DA I $P(^ABS(503335,DA,0),"^",12)=ABSV("SITE") D CREATE S:%=1 ^TMP(CPUJOB,"ABSVLIST",DA)=""
18 ;PRINT TRANSMISSION LIST AND ERROR LIST
19 S IOP=ABIOP,DIC="^ABS(503335,",L=0,DIS(0)="I $P($G(^ABS(503335,D0,0)),U,12)=ABSV(""SITE"")",(BY,FLDS)="[ABSV TRANSMIT]",BATCH=1,KOUNT=1 D EN1^DIP
20 S IOP=ABIOP,DIC="^ABS(503335,",L=0,DIS(0)="I $P($G(^ABS(503335,D0,0)),U,12)=ABSV(""SITE"")",(BY,FLDS)="[ABSV ERROR LIST]" D EN1^DIP
21 ;BUILD AND TRANSMIT MESSAGES
22 S KOUNT=0 F ZX=1:1 S KOUNT=$O(^TMP(CPUJOB,"ABSVBATCH",KOUNT)) Q:'KOUNT D BATCH
23 ;POST TRANSMISSION STATUS AND CLEAN UP ^TMP
24 S DA=0 F I=1:1 S DA=$O(^TMP(CPUJOB,"ABSVLIST",DA)) Q:'DA D UPDATE
25 K ^TMP(CPUJOB,"ABSVLIST"),^("ABSVBATCH"),%,%H,ABSVXI,ABIOP,ABSVX,BATCH,COMB,D1,DA,DIJ,DP,I,J,K,KOUNT,USIO,X,Y,ZTSK,ZX Q
26BATCH ;BUILD INDIVIDUAL MESSAGE
27 S XMDUZ=$S($D(DUZ)#2:DUZ,1:.5),XMSUB="VOLUNTEER TIME CARDS - MESSAGE "_ZX_" OF "_BATCH,XMTEXT="^TMP("""_CPUJOB_""",""ABSVBATCH"","_KOUNT_","
28 S XMY("XXX@Q-NST.VA.GOV")=""
29 S XMY("G.NST@"_$G(^XMB("NETNAME")))=""
30 D ^XMD
31 W !,XMZ," - Message Filed"
32 Q
33ERROR ;RECORD ERROR ON TIME CARD - RESET TRANSMISSION STATUS TO ERROR
34 S $P(^ABS(503335,DA,0),"^",6)=2,^ABS(503335,"AF",2,DA)="" K ^ABS(503335,"AF",1,DA) D K S %=0 Q
35CREATE ;CREATE TIME CARD STRING FOR CODE SHEET
36 S %=0 G ERROR:'$D(^ABS(503335,DA,0)),ERROR:'$D(^(1)) S TIMEREC=^(0),TIMEREC1=^(1),VOL=+TIMEREC G ERROR:'TIMEREC
37 S VOLREC=$S($D(^ABS(503330,VOL,0)):^(0),1:"") G ERROR:VOLREC=""
38 S STRING="",PSEUDO=$E($P(VOLREC,"^",18)_" ",1),SSN=$E($P(VOLREC,"^",2)_" ",1,9),NAME=$P(VOLREC,"^"),FNAME=$E($P(NAME,",",2)_" ",1,10),LNAME=$E($P(NAME,",")_" ",1,14)
39 S COMB=$E($P(TIMEREC,"^",2)_" ",1,8),MOYR=$P(TIMEREC,"^",5),MO=$E(MOYR,4,5),YR=$E(MOYR,2,3),MOYR=$E(MO_YR_" ",1,4),HUO=$E($P(TIMEREC1,"^",34)_" ",1,2)
40 S DAYS="" F I=1:1:31 I +$P(TIMEREC1,"^",I)>0 S DAYS=DAYS_($E($P(TIMEREC1,"^",I)_" ",1))
41 S SITE=$E($P(TIMEREC,"^",12)_" ",1,4)
42 I DAYS="",HUO=" " G ERROR
43 S STRING="06"_SITE_PSEUDO_SSN_COMB_FNAME_LNAME_HUO_MOYR_$E(DAYS,1,26)_"$"
44 S ^ABS(503335,DA,2)=STRING
45 D K Q
46UPDATE ;UPDATE TRANSMISSION STATUS
47 D NOW^ABSVQ S TIMEREC=^ABS(503335,DA,0),TRANS=$P(TIMEREC,"^",4) I TRANS="" S $P(TIMEREC,"^",4)=X,$P(TIMEREC,"^",9)=DUZ,$P(TIMEREC,"^",6)=3,^ABS(503335,DA,0)=TIMEREC,^ABS(503335,"AF",3,DA)="" K ^ABS(503335,"AF",1,DA) G K
48 S $P(TIMEREC,"^",10,11)=X_"^"_DUZ,$P(TIMEREC,"^",6)=4,^ABS(503335,DA,0)=TIMEREC,^ABS(503335,"AF",4,DA)="" K ^ABS(503335,"AF",1,DA)
49K K %,ABSVXX,ABSVXY,TIMEREC,TIMEREC1,VOL,VOLREC,STRING,PSEUDO,SSN,NAME,FNAME,LNAME,COMP,MOYR,YR,MO,HUO,DAYS,SITE S %=1 Q
50PRINT ;PRINT LIST OF QUEUED CODE SHEETS AND SUSPENDED CODE SHEETS
51 NEW %X,%Y,B,DP
52 D ^ABSVSITE Q:'% D WAIT^ABSVYN
53 S ZTDESC="VOLUNTARY SERVICE PRE-TRANSMISSION LISTINGS",ZTSAVE("ABSV*")="",ZTRTN="P1^ABSVT" D ^ABSVQ
54 QUIT
55P1 S DIC="^ABS(503335,",L=0,DIS(0)="I $P($G(^ABS(503335,D0,0)),U,12)=ABSV(""SITE"")",(FR,TO)="SUSPENDED",(BY,FLDS)="[ABSV BATCH LIST]",DHD="VOLUNTARY TIME CARD PRE-TRANSMISSION LISTING FOR "_ABSV("SITENAME")_" - SUSPENDED"
56 S:$D(ABIOP) IOP=ABIOP D EN1^DIP
57 S DIC="^ABS(503335,",L=0,DIS(0)="I $P($G(^ABS(503335,D0,0)),U,12)=ABSV(""SITE"")",(FR,TO)="READY FOR TRANSMISSION"
58 S (BY,FLDS)="[ABSV BATCH LIST]",DHD="VOLUNTARY TIME CARD PRE-TRANSMISSION LISTING FOR "_ABSV("SITENAME")_" - READY FOR TRANSMISSION"
59 S:$D(ABIOP) IOP=ABIOP D EN1^DIP
60 K ABSVXX,ABSVXY,DCC,DIJ,DIOP,DIPT,F,FLDS,L,O,P,W,X,ZTSK Q
Note: See TracBrowser for help on using the repository browser.