PRPFDR4 ;BAYPINES/MJE  VPFS DATA MIGRATION ROUTINE 4 ;05/15/03
 ;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989
 ;BAD ENTRY POINT
 Q
NODE1 S PFNODE1=$G(^PRPF(470,PRPFHLD1,1))
 S PFSTDBAL=$P(PFNODE1,"^",4)
 I PFSTDBAL>0 S CNTBAL=CNTBAL+PFSTDBAL
 I PFSTDBAL'="" I PFSTDBAL<0!(PFSTDBAL>99999)!((PFSTDBAL'=+PFSTDBAL)&(PFSTDBAL'?.N1".".N)) D
 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,27,PFNAME_"_"_PRPFHLD1)="STORED BALANCE^Stored balance invalid or out of range either < $0 or > $99,999^"_PFSTDBAL
 .S CNTERR(27)=CNTERR(27)+1
 .S CNTERR(100)=CNTERR(100)+1
 S PFSTDPVT=$P(PFNODE1,"^",5)
 I PFSTDPVT'="" I PFSTDPVT<0!(PFSTDPVT>99999)!((PFSTDPVT'=+PFSTDPVT)&(PFSTDPVT'?.N1".".N)) D
 .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
 .S CNTERR(28)=CNTERR(28)+1
 .S CNTERR(100)=CNTERR(100)+1
 S PFSTDGRT=$P(PFNODE1,"^",6)
 I PFSTDGRT'="" I PFSTDGRT<0!(PFSTDGRT>99999)!((PFSTDGRT'=+PFSTDGRT)&(PFSTDGRT'?.N1".".N)) D
 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,29,PFNAME_"_"_PRPFHLD1)="STORED GRATUITOUS^Stored gratuitous invalid or out of range either < $0 or > $99,999^"_PFSTDGRT
 .S CNTERR(29)=CNTERR(29)+1
 .S CNTERR(100)=CNTERR(100)+1
 S PFARPM=$P(PFNODE1,"^",7)
 I PFARPM'="" I PFARPM<0!(PFARPM>99999)!((PFARPM'=+PFARPM)&(PFARPM'?.N1".".N)) D
 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,30,PFNAME_"_"_PRPFHLD1)="RESTRICTED AMOUNT^Restricted monthly amount invalid or < $0 or > $99,999^"_PFARPM
 .S CNTERR(30)=CNTERR(30)+1
 .S CNTERR(100)=CNTERR(100)+1
 S PFARPW=$P(PFNODE1,"^",8)
 I PFARPW'="" I PFARPW<0!(PFARPW>99999)!((PFARPW'=+PFARPW)&(PFARPW'?.N1".".N)) D
 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,31,PFNAME_"_"_PRPFHLD1)="RESTRICTED AMOUNT^Restricted weekly amount invalid or < $0 or > $99,999^"_PFARPW
 .S CNTERR(31)=CNTERR(31)+1
 .S CNTERR(100)=CNTERR(100)+1
 I PFARPW'=""&(PFARPM'="") I PFARPM<(5*PFARPW) D
 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,32,PFNAME_"_"_PRPFHLD1)="RESTRCT AMT ER^Restrict Mnthly amount < (5X) weekly amt^"_PFARPM
 .S CNTERR(32)=CNTERR(32)+1
 .S CNTERR(100)=CNTERR(100)+1
 I PFARPW'=""&(PFARPM'="") I PFARPM<PFARPW D
 .S ^TMP("PRPF_DIAGX",$J,PFSTAID,33,PFNAME_"_"_PRPFHLD1)="RESTRCT AMT ER^Restrict Mnthly amount < weekly amt^"_PFARPM
 .S CNTERR(33)=CNTERR(33)+1
 .S CNTERR(100)=CNTERR(100)+1
 Q
NODE1X S ^TMP("PRPF_DIAGX",$J,PFSTAID,36,PFNAME_"_"_PRPFHLD1)="NO BALANCE REC^BALANCE RECORD DATA MISSING^"_PFNAME
 S CNTERR(36)=CNTERR(36)+1
 S CNTERR(100)=CNTERR(100)+1
 Q
NODE2 S PFNODE2=^PRPF(470,PRPFHLD1,2)
 S PFMIN1=$P(PFNODE2,"^",1)
 I PFMIN1'="" I PFMIN1<0!(PFMIN1>99999)!((PFMIN1'=+PFMIN1)&(PFMIN1'?.N1".".N)) D
 .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
 .S CNTERR(34)=CNTERR(34)+1
 .S CNTERR(100)=CNTERR(100)+1
 S PFMAX1=$P(PFNODE2,"^",2)
 I PFMAX1'="" I PFMAX1<0!(PFMAX1>99999)!((PFMAX1'=+PFMAX1)&(PFMAX1'?.N1".".N)) D
 .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
 .S CNTERR(35)=CNTERR(35)+1
 .S CNTERR(100)=CNTERR(100)+1
 Q
NODE6 S PRPFHLD2=0
 S (PFMCTR1,PFMCTR2,PFMCTR3)=1
 S PFMCTR1=1
 F  S PRPFHLD2=$O(^PRPF(470,PRPFHLD1,6,PRPFHLD2)) Q:'PRPFHLD2  D
 .S PFNODE6=^PRPF(470,PRPFHLD1,6,PRPFHLD2,0)
 .S PFINCPYE=$P(PFNODE6,"^",2)
 .I PFINCPYE="" D
 ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,37,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME PAYEE^Income payee blank, Income source present^"_PFINCPYE
 ..S PFMCTR1=PFMCTR1+1
 ..S CNTERR(37)=CNTERR(37)+1
 ..S CNTERR(100)=CNTERR(100)+1
 .S PFINCOME=$P(PFNODE6,"^",3)
 .I +PFINCOME'=PFINCOME&(PFINCOME'?.N1".".N) D
 ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,38,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME AMOUNT^Invalid income amount, Income source present^"_PFINCOME
 ..S PFMCTR2=PFMCTR2+1
 ..S CNTERR(38)=CNTERR(38)+1
 ..S CNTERR(100)=CNTERR(100)+1
 .I +PFINCOME=PFINCOME I PFINCOME<1!(PFINCOME>99999) D
 ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,39,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME AMOUNT^Income amount out of range either < $1 or > $99,999^"_PFINCOME
 ..S CNTERR(39)=CNTERR(39)+1
 ..S CNTERR(100)=CNTERR(100)+1
 .S PFINCFRQ=$P(PFNODE6,"^",4)
 .I PFINCFRQ="" D
 ..S PRPFBC40=PRPFBC40+1
 .I PFINCFRQ'["D"&(PFINCFRQ'["W")&(PFINCFRQ'["M")&(PFINCFRQ'["Y")&(PFINCFRQ'["X")&(PFINCFRQ'["V")&(PFINCFRQ'["O")&(PFINCFRQ'="") D
 ..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
 ..S PFMCTR3=PFMCTR3+1
 ..S CNTERR(40)=CNTERR(40)+1
 ..S CNTERR(100)=CNTERR(100)+1
 Q
KILLIT ;VARIABLES KILLED HERE
 K CNTBAL,CNTERR,CNTREC,CNTRPSU,CNTSEG,CNTTOT,ND,PARAMS,PFADDR1,PFADDR2
 K PFADDR3,PFAPPOR,PFARPM,PFARPW,PFAUTH,PFAUTHDT,PFAUTHRS,PFCITY,PFCLAIM,PFDOB
 K PFG,PFGUARD,PFICNFLG,PFINCFRQ,PFINCOME,PFINCPYE,PFINDIG,PFINSAWD,PFMAX1,PFMCTR1
 K PFMCTR2,PFMCTR3,PFMIN1,PFNAME,PFNAMEX,PFNODE0,PFNODE1,PFNODE2,PFNODE4,PFNODE4D
 K PFNODE4X,PFNODE5,PFNODE51,PFNODE52,PFNODE6,PFNODE7,PFNODE8,PFOTRAST,PFPSTAT
 K PFRGNID,PFSITE,PFSSN,PFSTAID,PFSTAT,PFSTATE,PFSTDBAL,PFSTDGRT,PFSTDPVT,PFSUSDT
 K PFSUSID,PFSUSTXT,PFTDT,PFTDTE,PFTEMP,PFTYPE,PFWARD,PFX,PFY,PFZ,PFZIP,POP,PRPFBADD
 K PRPFBBAL,PRPFBDMO,PRPFCNTR,PRPFDEFR,PRPFHLD1,PRPFHLD2,PRPFHLD3,PRPFHLD4,PRPFSEG
 K X,XION
 Q