source: FOIAVistA/trunk/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFDR4.m@ 1470

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1PRPFDR4 ;BAYPINES/MJE VPFS DATA MIGRATION ROUTINE 4 ;05/15/03
2 ;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989
3 ;BAD ENTRY POINT
4 Q
5NODE1 S PFNODE1=$G(^PRPF(470,PRPFHLD1,1))
6 S PFSTDBAL=$P(PFNODE1,"^",4)
7 I PFSTDBAL>0 S CNTBAL=CNTBAL+PFSTDBAL
8 I PFSTDBAL'="" I PFSTDBAL<0!(PFSTDBAL>99999)!((PFSTDBAL'=+PFSTDBAL)&(PFSTDBAL'?.N1".".N)) D
9 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,27,PFNAME_"_"_PRPFHLD1)="STORED BALANCE^Stored balance invalid or out of range either < $0 or > $99,999^"_PFSTDBAL
10 .S CNTERR(27)=CNTERR(27)+1
11 .S CNTERR(100)=CNTERR(100)+1
12 S PFSTDPVT=$P(PFNODE1,"^",5)
13 I PFSTDPVT'="" I PFSTDPVT<0!(PFSTDPVT>99999)!((PFSTDPVT'=+PFSTDPVT)&(PFSTDPVT'?.N1".".N)) D
14 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,28,PFNAME_"_"_PRPFHLD1)="STORED PRIVATE SOURCE^Stored private invalid or out of range either < $0 or > $99,999^"_PFSTDPVT
15 .S CNTERR(28)=CNTERR(28)+1
16 .S CNTERR(100)=CNTERR(100)+1
17 S PFSTDGRT=$P(PFNODE1,"^",6)
18 I PFSTDGRT'="" I PFSTDGRT<0!(PFSTDGRT>99999)!((PFSTDGRT'=+PFSTDGRT)&(PFSTDGRT'?.N1".".N)) D
19 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,29,PFNAME_"_"_PRPFHLD1)="STORED GRATUITOUS^Stored gratuitous invalid or out of range either < $0 or > $99,999^"_PFSTDGRT
20 .S CNTERR(29)=CNTERR(29)+1
21 .S CNTERR(100)=CNTERR(100)+1
22 S PFARPM=$P(PFNODE1,"^",7)
23 I PFARPM'="" I PFARPM<0!(PFARPM>99999)!((PFARPM'=+PFARPM)&(PFARPM'?.N1".".N)) D
24 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,30,PFNAME_"_"_PRPFHLD1)="RESTRICTED AMOUNT^Restricted monthly amount invalid or < $0 or > $99,999^"_PFARPM
25 .S CNTERR(30)=CNTERR(30)+1
26 .S CNTERR(100)=CNTERR(100)+1
27 S PFARPW=$P(PFNODE1,"^",8)
28 I PFARPW'="" I PFARPW<0!(PFARPW>99999)!((PFARPW'=+PFARPW)&(PFARPW'?.N1".".N)) D
29 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,31,PFNAME_"_"_PRPFHLD1)="RESTRICTED AMOUNT^Restricted weekly amount invalid or < $0 or > $99,999^"_PFARPW
30 .S CNTERR(31)=CNTERR(31)+1
31 .S CNTERR(100)=CNTERR(100)+1
32 I PFARPW'=""&(PFARPM'="") I PFARPM<(5*PFARPW) D
33 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,32,PFNAME_"_"_PRPFHLD1)="RESTRCT AMT ER^Restrict Mnthly amount < (5X) weekly amt^"_PFARPM
34 .S CNTERR(32)=CNTERR(32)+1
35 .S CNTERR(100)=CNTERR(100)+1
36 I PFARPW'=""&(PFARPM'="") I PFARPM<PFARPW D
37 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,33,PFNAME_"_"_PRPFHLD1)="RESTRCT AMT ER^Restrict Mnthly amount < weekly amt^"_PFARPM
38 .S CNTERR(33)=CNTERR(33)+1
39 .S CNTERR(100)=CNTERR(100)+1
40 Q
41NODE1X S ^TMP("PRPF_DIAGX",$J,PFSTAID,36,PFNAME_"_"_PRPFHLD1)="NO BALANCE REC^BALANCE RECORD DATA MISSING^"_PFNAME
42 S CNTERR(36)=CNTERR(36)+1
43 S CNTERR(100)=CNTERR(100)+1
44 Q
45NODE2 S PFNODE2=^PRPF(470,PRPFHLD1,2)
46 S PFMIN1=$P(PFNODE2,"^",1)
47 I PFMIN1'="" I PFMIN1<0!(PFMIN1>99999)!((PFMIN1'=+PFMIN1)&(PFMIN1'?.N1".".N)) D
48 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,34,PFNAME_"_"_PRPFHLD1)="MINIMUM BALANCE #1^MIN balance invalid or out of range either < $0 or > $99,999^"_PFMIN1
49 .S CNTERR(34)=CNTERR(34)+1
50 .S CNTERR(100)=CNTERR(100)+1
51 S PFMAX1=$P(PFNODE2,"^",2)
52 I PFMAX1'="" I PFMAX1<0!(PFMAX1>99999)!((PFMAX1'=+PFMAX1)&(PFMAX1'?.N1".".N)) D
53 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,35,PFNAME_"_"_PRPFHLD1)="MAXIMUM BALANCE #1^MAX balance invalid or out of range either < $0 or > $99,999^"_PFMAX1
54 .S CNTERR(35)=CNTERR(35)+1
55 .S CNTERR(100)=CNTERR(100)+1
56 Q
57NODE6 S PRPFHLD2=0
58 S (PFMCTR1,PFMCTR2,PFMCTR3)=1
59 S PFMCTR1=1
60 F S PRPFHLD2=$O(^PRPF(470,PRPFHLD1,6,PRPFHLD2)) Q:'PRPFHLD2 D
61 .S PFNODE6=^PRPF(470,PRPFHLD1,6,PRPFHLD2,0)
62 .S PFINCPYE=$P(PFNODE6,"^",2)
63 .I PFINCPYE="" D
64 ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,37,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME PAYEE^Income payee blank, Income source present^"_PFINCPYE
65 ..S PFMCTR1=PFMCTR1+1
66 ..S CNTERR(37)=CNTERR(37)+1
67 ..S CNTERR(100)=CNTERR(100)+1
68 .S PFINCOME=$P(PFNODE6,"^",3)
69 .I +PFINCOME'=PFINCOME&(PFINCOME'?.N1".".N) D
70 ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,38,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME AMOUNT^Invalid income amount, Income source present^"_PFINCOME
71 ..S PFMCTR2=PFMCTR2+1
72 ..S CNTERR(38)=CNTERR(38)+1
73 ..S CNTERR(100)=CNTERR(100)+1
74 .I +PFINCOME=PFINCOME I PFINCOME<1!(PFINCOME>99999) D
75 ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,39,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME AMOUNT^Income amount out of range either < $1 or > $99,999^"_PFINCOME
76 ..S CNTERR(39)=CNTERR(39)+1
77 ..S CNTERR(100)=CNTERR(100)+1
78 .S PFINCFRQ=$P(PFNODE6,"^",4)
79 .I PFINCFRQ="" D
80 ..S PRPFBC40=PRPFBC40+1
81 .I PFINCFRQ'["D"&(PFINCFRQ'["W")&(PFINCFRQ'["M")&(PFINCFRQ'["Y")&(PFINCFRQ'["X")&(PFINCFRQ'["V")&(PFINCFRQ'["O")&(PFINCFRQ'="") D
82 ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,40,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME FREQUENCY^Income frequency not D,W,M,Y,X,V,O,Blank^"_PFINCFRQ
83 ..S PFMCTR3=PFMCTR3+1
84 ..S CNTERR(40)=CNTERR(40)+1
85 ..S CNTERR(100)=CNTERR(100)+1
86 Q
87KILLIT ;VARIABLES KILLED HERE
88 K CNTBAL,CNTERR,CNTREC,CNTRPSU,CNTSEG,CNTTOT,ND,PARAMS,PFADDR1,PFADDR2
89 K PFADDR3,PFAPPOR,PFARPM,PFARPW,PFAUTH,PFAUTHDT,PFAUTHRS,PFCITY,PFCLAIM,PFDOB
90 K PFG,PFGUARD,PFICNFLG,PFINCFRQ,PFINCOME,PFINCPYE,PFINDIG,PFINSAWD,PFMAX1,PFMCTR1
91 K PFMCTR2,PFMCTR3,PFMIN1,PFNAME,PFNAMEX,PFNODE0,PFNODE1,PFNODE2,PFNODE4,PFNODE4D
92 K PFNODE4X,PFNODE5,PFNODE51,PFNODE52,PFNODE6,PFNODE7,PFNODE8,PFOTRAST,PFPSTAT
93 K PFRGNID,PFSITE,PFSSN,PFSTAID,PFSTAT,PFSTATE,PFSTDBAL,PFSTDGRT,PFSTDPVT,PFSUSDT
94 K PFSUSID,PFSUSTXT,PFTDT,PFTDTE,PFTEMP,PFTYPE,PFWARD,PFX,PFY,PFZ,PFZIP,POP,PRPFBADD
95 K PRPFBBAL,PRPFBDMO,PRPFCNTR,PRPFDEFR,PRPFHLD1,PRPFHLD2,PRPFHLD3,PRPFHLD4,PRPFSEG
96 K X,XION
97 Q
Note: See TracBrowser for help on using the repository browser.