source: WorldVistAEHR/trunk/r/PAID-PRS/PRSAXMIT.m@ 1261

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1PRSAXMIT ; HISC/FPT-Transmit 8B Records ;8/17/95 08:45
2 ;;4.0;PAID;;Sep 21, 1995
3 ; VARIABLES USED
4 ; --------- ----
5 ; EMPCNT = number of employees processed
6 ; IEN = employee's internal entry number (file 450)
7 ; LENGTH = length of 8b record
8 ; LOOP = for loop variable
9 ; PPE = pay period
10 ; PPI = pay period internal entry number
11 ; RECCNT = number of records per message
12 ; RECORD = 8b record
13 ; STUB = characters 1 thru 32 of the 8b record
14 ; SN = station number
15 ; TLE = t&l unit number
16 ; TLI = t&l unit internal entry number (#455.5)
17 ; TRECCNT = total number of records transmitted
18 ;
19 ; ARRAYS USED
20 ; ------ ----
21 ; ^TMP($J) = 8b records that will be passed to xmtext
22 ; ^TMP("PRSA",$J) = employee iens (used to change status of record)
23 ;
24 K DIC S DIC="^PRST(458,",DIC(0)="AEMQZ" S PPI=$P($G(^PRST(458,0)),U,3) I PPI<1 D KILL Q
25 S DIC("B")=$P(^PRST(458,PPI,0),U,1) D ^DIC K DIC I +Y<1 D KILL Q
26 S PPI=+Y D CHECK G:YN["^" KILL
27 S PPE=$P($P(^PRST(458,PPI,0),U),"-",2)
28 K DIR S DIR(0)="Y",DIR("A")="Ready to Transmit to Austin",DIR("B")="NO"
29 W ! D ^DIR K DIR I $D(DIRUT)!(Y=0) D KILL Q
30 W !!,"Transmitting to Austin "
31 K ^TMP("PRSA",$J),^TMP($J)
32 S (EMPCNT,IEN,RECCNT,TRECCNT)=0
33 F S IEN=$O(^PRST(458,PPI,"E",IEN)) Q:IEN'>0 I $P($G(^PRST(458,PPI,"E",IEN,0)),U,2)="P" D PROCESS D:RECCNT>174 MAIL
34 D:RECCNT>0 MAIL
35 S X="N",%DT="XT" D ^%DT S NOW=+Y K %DT
36 I EMPCNT>0 S $P(^PRST(458,PPI,0),U,2)=DUZ,$P(^PRST(458,PPI,0),U,3)=NOW,$P(^PRST(458,PPI,0),U,4)=$P(^PRST(458,PPI,0),U,4)+EMPCNT,$P(^PRST(458,PPI,0),U,5)=$P(^PRST(458,PPI,0),U,5)+TRECCNT
37 ;
38 W !!,EMPCNT," Employees Processed",!
39KILL K DIR,DIROUT,DIRUT,DTOUT,DUOUT,EMPCNT,IEN,NOW,PPE,PPI,RECCNT,RECORD,SN,TLE,TLI,TRECCNT,X,Y Q
40 ;
41PROCESS ;
42 S RECORD=$G(^PRST(458,PPI,"E",IEN,5))
43 I RECORD="" W !,"8B record is missing for ",$P($G(^PRSPC(IEN,0)),U,1) Q
44 S TLE=$E(RECORD,22,24)
45 S EMPCNT=EMPCNT+1,STUB=$E(RECORD,1,32)
46AGAIN I $L(RECORD)<81 S RECCNT=RECCNT+1,^TMP($J,RECCNT)=RECORD_$J("",80-$L(RECORD)) W:RECCNT#100=1 "." S ^TMP("PRSA",$J,IEN)="" K LENGTH,RECORD,STUB Q
47 F LENGTH=80:-1:33 Q:$E(RECORD,LENGTH-1,LENGTH)?2U
48 S RECCNT=RECCNT+1,^TMP($J,RECCNT)=$E(RECORD,1,LENGTH-2)_$J("",80-(LENGTH-2)),RECORD=STUB_$E(RECORD,LENGTH-1,$L(RECORD)) G AGAIN
49 Q
50 ;
51MAIL ; call MailMan
52 S XMDUZ=.5
53 S XMY("G.TAB@"_^XMB("NETNAME"))=""
54 S XMY("XXX@Q-TAB.VA.GOV")=""
55 S SN=$P($G(^XMB(1,1,"XUS")),"^",17),SN=$S(+SN>0:$P($G(^DIC(4,SN,99)),"^",1),1:"")
56 S XMSUB=^DD("SITE")_" ("_SN_") Payroll Data (Pay Period "_PPE_")"
57 S XMTEXT="^TMP($J,",XMDUZ=.5 D ^XMD
58 I XMZ>0 D
59 .S LOOP=0 F S LOOP=$O(^TMP("PRSA",$J,LOOP)) Q:LOOP'>0 S $P(^PRST(458,PPI,"E",LOOP,0),U,2)="X"
60 .S:'$D(^PRST(458,PPI,"X",0)) ^PRST(458,PPI,"X",0)="^458.03P^^" K DIC,DD,DO S DIC="^PRST(458,PPI,""X"",",DIC(0)="L",DLAYGO=458,DA(1)=PPI,(X,DINUM)=XMZ D FILE^DICN K DIC,DINUM
61 .D NOW^%DTC
62 .S $P(^PRST(458,PPI,"X",+Y,0),U,2)=DUZ
63 .S $P(^PRST(458,PPI,"X",+Y,0),U,3)=%
64 .S TRECCNT=TRECCNT+RECCNT
65 S RECCNT=0
66 K %,^TMP("PRSA",$J),^TMP($J),DA,DD,DIC,DINUM,DLAYGO,DO,LOOP,X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y,XMLOC,XMMG Q
67CHECK ; Run 8B Edit Check
68 W !!,"Edit Checks will now be run ...",!
69 D CODES^PRSACED6 S YN="",COUNT=0,HDR=1
70 S ATL="ATL00" F S ATL=$O(^PRSPC(ATL)) Q:ATL'?1"ATL".E S TL=$E(ATL,4,6),NAM="" F S NAM=$O(^PRSPC(ATL,NAM)) Q:NAM="" F DFN=0:0 S DFN=$O(^PRSPC(ATL,NAM,DFN)) Q:DFN<1 D G:YN["^" AB
71 .I '$D(^PRST(458,PPI,"E",DFN,5)) Q
72 .I $P(^PRST(458,PPI,"E",DFN,0),"^",2)'="P" Q
73 .S COUNT=COUNT+1 D ^PRSACED1 W:COUNT#50=1 "." Q
74 Q
75AB W !,"Edit Checks aborted. NO Transmission.",! Q
Note: See TracBrowser for help on using the repository browser.