source: FOIAVistA/tag/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFDR1.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: 8.5 KB
Line 
1PRPFDR1 ;BAYPINES/MJE VPFS DATA MIGRATION ROUTINE 1 ;05/15/03
2 ;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989
3 ;BAD ENTRY POINT
4 Q
5NODE4 S PRPFHLD2=0
6 F S PRPFHLD2=$O(^PRPF(470,PRPFHLD1,4,PRPFHLD2)) Q:'PRPFHLD2 D
7 .S PFNODE4=^PRPF(470,PRPFHLD1,4,PRPFHLD2,0)
8 .I '$D(^PRPF(470.1,+$P(PFNODE4,"^",1),0)) D
9 ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,47,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="TRANSACTION REC^Transaction record missing, blank or ID invalid (Transaction missing)^"_$P(PFNODE4,"^",1)
10 ..S CNTERR(47)=CNTERR(47)+1
11 ..S CNTERR(100)=CNTERR(100)+1
12 .I $D(^PRPF(470.1,+$P(PFNODE4,"^",1),0)) D
13 ..S PFNODE4D=^PRPF(470.1,$P(PFNODE4,"^",1),0)
14 ..I PFNODE4D="" D
15 ...S ^TMP("PRPF_DIAGX",$J,PFSTAID,47,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="TRANSACTION REC^Transaction record missing, blank or ID invalid (Record blank)^"_$P(PFNODE4,"^",1)
16 ...S CNTERR(47)=CNTERR(47)+1
17 ...S CNTERR(100)=CNTERR(100)+1
18 ..I PFNODE4D'="" D
19 ...I +($P(PFNODE4D,"^",1))'=+$P(PFNODE4,"^",1) D
20 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,47,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="TRANSACTION REC^Transaction record missing, blank or ID invalid (Transaction ID does not match IEN)^"_$P(PFNODE4,"^",1)
21 ....S CNTERR(47)=CNTERR(47)+1
22 ....S CNTERR(100)=CNTERR(100)+1
23 ...I $P(PFNODE4D,"^",2)'=PRPFHLD1 D
24 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,48,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT NAME^Patient name does not match transaction^"_$P(PFNODE4D,"^",2)
25 ....S CNTERR(48)=CNTERR(48)+1
26 ....S CNTERR(100)=CNTERR(100)+1
27 ...S PFNODE4X=$P(PFNODE4D,"^",3)
28 ...I +PFNODE4X'=PFNODE4X!(PFNODE4X>99999)!(PFNODE4X<1) D
29 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,49,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT TRANSACTION #^Patient transaction # invalid^"_$P(PFNODE4D,"^",3)
30 ....S CNTERR(49)=CNTERR(49)+1
31 ....S CNTERR(100)=CNTERR(100)+1
32 ...S PFNODE4X=$P(PFNODE4D,"^",4)
33 ...I PFNODE4X=""!(+PFNODE4X'=PFNODE4X)&(PFNODE4X'?.N1".".N)!(PFNODE4X>99999)!(PFNODE4X<.01) D
34 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,50,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="AMOUNT^Deferred amount invalid^"_$P(PFNODE4D,"^",4)
35 ....S CNTERR(50)=CNTERR(50)+1
36 ....S CNTERR(100)=CNTERR(100)+1
37 ...S PFTDT=$P(PFNODE4D,"^",5)
38 ...S PRPFBADD=""
39 ...D DT^DILF("X",PFTDT,.PRPFBADD)
40 ...I $L(+PFTDT)'=7!(PRPFBADD=-1)!(PRPFBADD="") D
41 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,51,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="TRANSACTION DATE^Transaction date Invalid^"_$P(PFNODE4D,"^",5)
42 ....S CNTERR(51)=CNTERR(51)+1
43 ....S CNTERR(100)=CNTERR(100)+1
44 ...S PFTDTE=$P(PFNODE4D,"^",6)
45 ...S PRPFBADD=""
46 ...D DT^DILF("X",PFTDTE,.PRPFBADD)
47 ...I $L(+PFTDTE)'=7!(PRPFBADD=-1)!(PRPFBADD="") D
48 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,52,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="DATE TRANSACTION ENTERED^Date transaction entered Invalid^"_$P(PFNODE4D,"^",6)
49 ....S CNTERR(52)=CNTERR(52)+1
50 ....S CNTERR(100)=CNTERR(100)+1
51 ...S PFNODE4X=$P(PFNODE4D,"^",7)
52 ...I $L(PFNODE4X)>10!($L(PFNODE4X)<1) D
53 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,53,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="REFERENCE^Reference Invalid < 1 or > 10 in length^"_$P(PFNODE4D,"^",7)
54 ....S CNTERR(53)=CNTERR(53)+1
55 ....S CNTERR(100)=CNTERR(100)+1
56 ...S PFNODE4X=$P(PFNODE4D,"^",8)
57 ...I PFNODE4X'["D"&(PFNODE4X'["W") D
58 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,54,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="DEPOSIT/WITHDRAWAL^Deposit/Withdrawal status Invalid^"_$P(PFNODE4D,"^",8)
59 ....S CNTERR(54)=CNTERR(54)+1
60 ....S CNTERR(100)=CNTERR(100)+1
61 ...S PFNODE4X=$P(PFNODE4D,"^",9)
62 ...I PFNODE4X'["1"&(PFNODE4X'["2")&(PFNODE4X'["3") D
63 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,55,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="CASH/CHECK/OTHER^Cash/Check/Other status Invalid^"_$P(PFNODE4D,"^",9)
64 ....S CNTERR(55)=CNTERR(55)+1
65 ....S CNTERR(100)=CNTERR(100)+1
66 ...S PFNODE4X=$P(PFNODE4D,"^",10)
67 ...I PFNODE4X'["P"&(PFNODE4X'["G")&(PFNODE4X'="B") D
68 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,56,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="SOURCE^Transaction source invalid^"_$P(PFNODE4D,"^",10)
69 ....S CNTERR(56)=CNTERR(56)+1
70 ....S CNTERR(100)=CNTERR(100)+1
71 ...I $P(PFNODE4D,"^",11)="" D
72 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,57,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="FORM^Form does not match^"_$P(PFNODE4D,"^",11)
73 ....S CNTERR(57)=CNTERR(57)+1
74 ....S CNTERR(100)=CNTERR(100)+1
75 ...I $P(PFNODE4D,"^",11)'="" D
76 ....I '$D(^PRPF(470.2,$P(PFNODE4D,"^",11),0)) D
77 .....S ^TMP("PRPF_DIAGX",$J,PFSTAID,57,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="FORM^Form does not match^"_$P(PFNODE4D,"^",11)
78 .....S CNTERR(57)=CNTERR(57)+1
79 .....S CNTERR(100)=CNTERR(100)+1
80 ...S PFNODE4X=$P(PFNODE4D,"^",12)
81 ...I PFNODE4X'="" I +PFNODE4X'=PFNODE4X&(PFNODE4X'?.N1".".N)!(PFNODE4X>99999)!(PFNODE4X<.01) D
82 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,58,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PRIVATE SOURCE AMT^Pvt src amt invalid or < 0 or > 99999^"_$P(PFNODE4D,"^",12)
83 ....S CNTERR(58)=CNTERR(58)+1
84 ....S CNTERR(100)=CNTERR(100)+1
85 ...S PFNODE4X=$P(PFNODE4D,"^",13)
86 ...I PFNODE4X'="" I +PFNODE4X'=PFNODE4X&(PFNODE4X'?.N1".".N)!(PFNODE4X>99999)!(PFNODE4X<.01) D
87 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,59,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="GRATUITOUS AMOUNT^Gratuitous amt invalid or < 0 or > 99999^"_$P(PFNODE4D,"^",13)
88 ....S CNTERR(59)=CNTERR(59)+1
89 ....S CNTERR(100)=CNTERR(100)+1
90 ...S PFNODE4X=$P(PFNODE4D,"^",14)
91 ...I PFNODE4X'="" D
92 ....I '$D(^VA(200,PFNODE4X,0))!($L($P($G(^VA(200,PFNODE4X,0)),"^",1))<3!($L($P($G(^VA(200,PFNODE4X,0)),"^",1))>35)) D
93 .....S ^TMP("PRPF_DIAGX",$J,PFSTAID,60,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT FUNDS CLERK^Pfunds clerk invalid^"_$P($G(^VA(200,PFNODE4X,0)),"^",1)
94 .....S CNTERR(60)=CNTERR(60)+1
95 .....S CNTERR(100)=CNTERR(100)+1
96 ...I PFNODE4X="" D
97 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,60,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT FUNDS CLERK^Pfunds clerk invalid^"_""
98 ....S CNTERR(60)=CNTERR(60)+1
99 ....S CNTERR(100)=CNTERR(100)+1
100 .S PRPFDEFR=PRPFDEFR+1
101 Q
102NODE5 S (PRPFHLD2,PRPFHLD3,PRPFHLD4)=0
103 F S PRPFHLD2=$O(^PRPF(470,PRPFHLD1,5,PRPFHLD2)) Q:'PRPFHLD2 D
104 .S PFNODE5=$G(^PRPF(470,PRPFHLD1,5,PRPFHLD2,0))
105 .S PFSUSDT=$P(PFNODE5,"^",1)
106 .I PFSUSDT="" D
107 ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,43.1,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2)="SUSPENSE DATE^Suspense date is blank^"_PFSUSDT
108 ..S CNTERR(43)=CNTERR(43)+1
109 ..S CNTERR(100)=CNTERR(100)+1
110 .ELSE D
111 ..K PRPFBADD
112 ..D DT^DILF("X",PFSUSDT,.PRPFBADD)
113 ..I $L(+PFSUSDT)'=7!(PRPFBADD=-1) D
114 ...S ^TMP("PRPF_DIAGX",$J,PFSTAID,43.2,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2)="SUSPENSE DATE^Suspense date is not valid^"_PFSUSDT
115 ...S CNTERR(43)=CNTERR(43)+1
116 ...S CNTERR(100)=CNTERR(100)+1
117 .F S PRPFHLD3=$O(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3)) Q:'PRPFHLD3 D
118 ..S PFNODE51=$G(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3,0))
119 ..S PFSUSID=PFNODE51
120 ..I PFSUSID="" D
121 ...S ^TMP("PRPF_DIAGX",$J,PFSTAID,44.1,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE ID^Suspense ID is blank^"_PFSUSID
122 ...S CNTERR(44)=CNTERR(44)+1
123 ...S CNTERR(100)=CNTERR(100)+1
124 ..I PFSUSID'="" I $L(PFSUSID)<1!($L(PFSUSID)>40) D
125 ...S ^TMP("PRPF_DIAGX",$J,PFSTAID,44.2,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE ID^Suspense ID < 1 or > 40 characters^"_PFSUSID
126 ...S CNTERR(44)=CNTERR(44)+1
127 ...S CNTERR(100)=CNTERR(100)+1
128 ..S PFSUSTXT=""
129 ..F S PRPFHLD4=$O(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3,1,PRPFHLD4)) Q:'PRPFHLD4 D
130 ...S PFNODE52=$G(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3,1,PRPFHLD4,0))
131 ...S PFSUSTXT=PFSUSTXT_PFNODE52
132 ..I PFSUSTXT="" D
133 ...S ^TMP("PRPF_DIAGX",$J,PFSTAID,45.1,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE DESC^Suspense description is blank^"_PFSUSTXT
134 ...S CNTERR(45)=CNTERR(45)+1
135 ...S CNTERR(100)=CNTERR(100)+1
136 ..I PFSUSTXT'="" I $L(PFSUSTXT)<1!($L(PFSUSTXT)>255) D
137 ...S ^TMP("PRPF_DIAGX",$J,PFSTAID,45.2,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE DESC^Suspense description < 1 or > 255 characters^"_"SUSPENSE ID="_PFSUSID_", DESCRIPTION LENGTH="_$L(PFSUSTXT)
138 ...S CNTERR(45)=CNTERR(45)+1
139 ...S CNTERR(100)=CNTERR(100)+1
140 ..S PRPFHLD4=0
141 .S PRPFHLD3=0
142 Q
143NODE12 I $G(^PRPF(470,PRPFHLD1,12))'="" D
144 .I '$D(^DIC(4,^PRPF(470,PRPFHLD1,12),99))!(PFSTAID="ERRBADID")!(PFSTAID="ERRBADID1") D
145 ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,42,PFNAME_"_"_PRPFHLD1)="STATIONID^STATION ID INVALID^"_PFSTAID
146 ..S CNTERR(42)=CNTERR(42)+1
147 ..S CNTERR(100)=CNTERR(100)+1
148 S:$G(^PRPF(470,PRPFHLD1,12))="" PFSTAID="UNASSIGNED"
149NODE12X I PFSTAID=""!(PFSTAID="UNASSIGNED")!(PFSTAID="ERRNOID")!(PFSTAID="ERRNOID1") D
150 .S:PFSTAID="" PFSTAID="UNASSIGNED"
151 .S CNTERR(41)=CNTERR(41)+1
152 .S CNTERR(100)=CNTERR(100)+1
153 Q
Note: See TracBrowser for help on using the repository browser.