source: FOIAVistA/tag/r/PAID-PRS/PRSDSET.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1PRSDSET ;HISC/MGD-PAID DOWNLOAD SET LOGIC ;09/13/2003
2 ;;4.0;PAID;**48,78,82**;Sep 21, 1995
3LDSET ;Initial download processor
4 S DATA=$P(RCD,":",CC),DBNAME=$P(FLD,";",3)
5 I (DBNAME="MAPRVAST")!(DBNAME="MAPRVAOT")!(DBNAME="MXSSN") Q
6 I (DBNAME="MBSTATFR")!(DBNAME="MBSACODE")!(DBNAME="MBSADATE")!(DBNAME="MBSANOAC"),DATA="" Q
7 I (DBNAME="MXFTAXEX")!(DBNAME["EXEMPTION")!(DBNAME="MXNORMHR")!(DBNAME="MXFTEEAJ"),DATA="" S DATA=0
8 S NODE=$P(FLD,";",5),PIECE=$P(FLD,";",6),FLDNUM=$P(FLD,";",12)
9 X:(DATA'="")&($P(FLD,";",7)'="") $P(FLD,";",7)
10 I (NODE="LD"),(DATA=""),($P(FLD,";",7)'="") X $P(FLD,";",7)
11 Q:(NODE="")!(PIECE="")
12 I FLDNUM'="",$D(^DD(450,"IX",FLDNUM)) S:$D(^PRSPC(IEN,NODE)) X=$P(^PRSPC(IEN,NODE),U,PIECE),DA=IEN D KILL^PRSDXREF
13 I NODE'="LD" S $P(^PRSPC(IEN,NODE),U,PIECE)=DATA
14 I NODE="LD",(MULT) D LD
15 I FLDNUM'="",$D(^DD(450,"IX",FLDNUM)) S X=DATA D SET^PRSDXREF
16 K MFLD,MULT
17 Q
18EPTSET ;Edit & Update, Payrun and Transfer download processor
19 S DBNAME=$P(FLD,";",3)
20 Q:(DBNAME="MAPRVAST and MAPRVAOT")!(DBNAME="MXSSN")
21 S E1=$P(FLD,";",5),E2=$P(FLD,";",6)
22 S NODE=$P(FLD,";",7),PIECE=$P(FLD,";",8),DATA=$E(GRPVAL,E1,E2)
23 ; Patch 48 - prevent overwriting FEGLI code if AAC does not implement
24 ; their change before patch is installed.
25 Q:DBNAME="MXFEGLI"&(DATA="")
26 S NODE459=$P(FLD,";",10),PIECE459=$P(FLD,";",11),FLDNUM=$P(FLD,";",12)
27 S ADDFLG=$P(FLD,";",13) D RTS^PRSDUTIL
28 X:$P(FLD,";",9)'="" $P(FLD,";",9)
29 Q:(NODE="")!(PIECE="")
30 I FLDNUM'="",$D(^DD(450,"IX",FLDNUM)) S:$D(^PRSPC(IEN,NODE)) X=$P(^PRSPC(IEN,NODE),U,PIECE),DA=IEN D KILL^PRSDXREF
31 I NODE'="LD" S $P(^PRSPC(IEN,NODE),U,PIECE)=DATA
32 I NODE="LD",(MULT) D LD
33 I FLDNUM'="",$D(^DD(450,"IX",FLDNUM)) S X=DATA D SET^PRSDXREF
34 I TYPE="P",DATA'="",PP'="",NODE459'="",PIECE459'="" D SET459
35 K MFLD,MULT
36 Q
37SET459 I (ADDFLG="O")!('$D(^PRST(459,PPIEN,"P",IEN,NODE459))) S $P(^PRST(459,PPIEN,"P",IEN,NODE459),U,PIECE459)=DATA Q
38 I $P(^PRST(459,PPIEN,"P",IEN,NODE459),U,PIECE459)="" S $P(^PRST(459,PPIEN,"P",IEN,NODE459),U,PIECE459)=DATA Q
39 S SUM=$P(^PRST(459,PPIEN,"P",IEN,NODE459),U,PIECE459)+DATA
40 I DATA["." S NOD=$L($P(DATA,".",2)),SUM=$J(SUM,0,NOD)
41 S:+SUM=0 SUM=""
42 I FLDNUM'="",$D(^DD(450,"IX",FLDNUM)) S:$D(^PRSPC(IEN,NODE)) X=$P(^PRSPC(IEN,NODE),U,PIECE),DA=IEN D KILL^PRSDXREF
43 I NODE'="LD" D
44 . S $P(^PRST(459,PPIEN,"P",IEN,NODE459),U,PIECE459)=SUM
45 . S $P(^PRSPC(IEN,NODE),U,PIECE)=SUM
46 I NODE="LD",(MULT) D
47 . K PRSFDA
48 . S IENS="?+"_MULT_","_IEN_","_PPIEN_","
49 . S PRSFDA(459.11054,IENS,.01)=MULT
50 . S PRSFDA(459.11054,IENS,FLD)=DATA
51 . D UPDATE^DIE("","PRSFDA","IENS","MGD")
52 . K PRSFDA
53 . D LD
54 I FLDNUM'="",$D(^DD(450,"IX",FLDNUM)) S X=SUM D SET^PRSDXREF
55 K MFLD,MFLD,NOD
56 Q
57LD ; Update LABOR DISTRIBUTION Multiple (450.0757)
58 K PRSFDA
59 S IENS="?+"_MULT_","_IEN_","
60 S PRSFDA(450.0757,IENS,.01)=MULT
61 S PRSFDA(450.0757,IENS,MFLD)=DATA
62 D UPDATE^DIE("","PRSFDA","IENS")
63 Q
Note: See TracBrowser for help on using the repository browser.