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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFDR4 5381 printed Apr 09, 2024@21:04:54 Page 2
PRPFDR4 ;BAYPINES/MJE VPFS DATA MIGRATION ROUTINE 4 ;05/15/03
+1 ;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989
+2 ;BAD ENTRY POINT
+3 QUIT
NODE1 SET PFNODE1=$GET(^PRPF(470,PRPFHLD1,1))
+1 SET PFSTDBAL=$PIECE(PFNODE1,"^",4)
+2 IF PFSTDBAL>0
SET CNTBAL=CNTBAL+PFSTDBAL
+3 IF PFSTDBAL'=""
IF PFSTDBAL<0!(PFSTDBAL>99999)!((PFSTDBAL'=+PFSTDBAL)&(PFSTDBAL'?.N1".".N))
Begin DoDot:1
+4 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,27,PFNAME_"_"_PRPFHLD1)="STORED BALANCE^Stored balance invalid or out of range either < $0 or > $99,999^"_PFSTDBAL
+5 SET CNTERR(27)=CNTERR(27)+1
+6 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+7 SET PFSTDPVT=$PIECE(PFNODE1,"^",5)
+8 IF PFSTDPVT'=""
IF PFSTDPVT<0!(PFSTDPVT>99999)!((PFSTDPVT'=+PFSTDPVT)&(PFSTDPVT'?.N1".".N))
Begin DoDot:1
+9 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,28,PFNAME_"_"_PRPFHLD1)="STORED PRIVATE SOURCE^Stored private invalid or out of range either < $0 or > $99,999^"_PFSTDPVT
+10 SET CNTERR(28)=CNTERR(28)+1
+11 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+12 SET PFSTDGRT=$PIECE(PFNODE1,"^",6)
+13 IF PFSTDGRT'=""
IF PFSTDGRT<0!(PFSTDGRT>99999)!((PFSTDGRT'=+PFSTDGRT)&(PFSTDGRT'?.N1".".N))
Begin DoDot:1
+14 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,29,PFNAME_"_"_PRPFHLD1)="STORED GRATUITOUS^Stored gratuitous invalid or out of range either < $0 or > $99,999^"_PFSTDGRT
+15 SET CNTERR(29)=CNTERR(29)+1
+16 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+17 SET PFARPM=$PIECE(PFNODE1,"^",7)
+18 IF PFARPM'=""
IF PFARPM<0!(PFARPM>99999)!((PFARPM'=+PFARPM)&(PFARPM'?.N1".".N))
Begin DoDot:1
+19 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,30,PFNAME_"_"_PRPFHLD1)="RESTRICTED AMOUNT^Restricted monthly amount invalid or < $0 or > $99,999^"_PFARPM
+20 SET CNTERR(30)=CNTERR(30)+1
+21 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+22 SET PFARPW=$PIECE(PFNODE1,"^",8)
+23 IF PFARPW'=""
IF PFARPW<0!(PFARPW>99999)!((PFARPW'=+PFARPW)&(PFARPW'?.N1".".N))
Begin DoDot:1
+24 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,31,PFNAME_"_"_PRPFHLD1)="RESTRICTED AMOUNT^Restricted weekly amount invalid or < $0 or > $99,999^"_PFARPW
+25 SET CNTERR(31)=CNTERR(31)+1
+26 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+27 IF PFARPW'=""&(PFARPM'="")
IF PFARPM<(5*PFARPW)
Begin DoDot:1
+28 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,32,PFNAME_"_"_PRPFHLD1)="RESTRCT AMT ER^Restrict Mnthly amount < (5X) weekly amt^"_PFARPM
+29 SET CNTERR(32)=CNTERR(32)+1
+30 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+31 IF PFARPW'=""&(PFARPM'="")
IF PFARPM<PFARPW
Begin DoDot:1
+32 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,33,PFNAME_"_"_PRPFHLD1)="RESTRCT AMT ER^Restrict Mnthly amount < weekly amt^"_PFARPM
+33 SET CNTERR(33)=CNTERR(33)+1
+34 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+35 QUIT
NODE1X SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,36,PFNAME_"_"_PRPFHLD1)="NO BALANCE REC^BALANCE RECORD DATA MISSING^"_PFNAME
+1 SET CNTERR(36)=CNTERR(36)+1
+2 SET CNTERR(100)=CNTERR(100)+1
+3 QUIT
NODE2 SET PFNODE2=^PRPF(470,PRPFHLD1,2)
+1 SET PFMIN1=$PIECE(PFNODE2,"^",1)
+2 IF PFMIN1'=""
IF PFMIN1<0!(PFMIN1>99999)!((PFMIN1'=+PFMIN1)&(PFMIN1'?.N1".".N))
Begin DoDot:1
+3 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,34,PFNAME_"_"_PRPFHLD1)="MINIMUM BALANCE #1^MIN balance invalid or out of range either < $0 or > $99,999^"_PFMIN1
+4 SET CNTERR(34)=CNTERR(34)+1
+5 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+6 SET PFMAX1=$PIECE(PFNODE2,"^",2)
+7 IF PFMAX1'=""
IF PFMAX1<0!(PFMAX1>99999)!((PFMAX1'=+PFMAX1)&(PFMAX1'?.N1".".N))
Begin DoDot:1
+8 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,35,PFNAME_"_"_PRPFHLD1)="MAXIMUM BALANCE #1^MAX balance invalid or out of range either < $0 or > $99,999^"_PFMAX1
+9 SET CNTERR(35)=CNTERR(35)+1
+10 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+11 QUIT
NODE6 SET PRPFHLD2=0
+1 SET (PFMCTR1,PFMCTR2,PFMCTR3)=1
+2 SET PFMCTR1=1
+3 FOR
SET PRPFHLD2=$ORDER(^PRPF(470,PRPFHLD1,6,PRPFHLD2))
if 'PRPFHLD2
QUIT
Begin DoDot:1
+4 SET PFNODE6=^PRPF(470,PRPFHLD1,6,PRPFHLD2,0)
+5 SET PFINCPYE=$PIECE(PFNODE6,"^",2)
+6 IF PFINCPYE=""
Begin DoDot:2
+7 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,37,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME PAYEE^Income payee blank, Income source present^"_PFINCPYE
+8 SET PFMCTR1=PFMCTR1+1
+9 SET CNTERR(37)=CNTERR(37)+1
+10 SET CNTERR(100)=CNTERR(100)+1
End DoDot:2
+11 SET PFINCOME=$PIECE(PFNODE6,"^",3)
+12 IF +PFINCOME'=PFINCOME&(PFINCOME'?.N1".".N)
Begin DoDot:2
+13 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,38,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME AMOUNT^Invalid income amount, Income source present^"_PFINCOME
+14 SET PFMCTR2=PFMCTR2+1
+15 SET CNTERR(38)=CNTERR(38)+1
+16 SET CNTERR(100)=CNTERR(100)+1
End DoDot:2
+17 IF +PFINCOME=PFINCOME
IF PFINCOME<1!(PFINCOME>99999)
Begin DoDot:2
+18 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,39,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME AMOUNT^Income amount out of range either < $1 or > $99,999^"_PFINCOME
+19 SET CNTERR(39)=CNTERR(39)+1
+20 SET CNTERR(100)=CNTERR(100)+1
End DoDot:2
+21 SET PFINCFRQ=$PIECE(PFNODE6,"^",4)
+22 IF PFINCFRQ=""
Begin DoDot:2
+23 SET PRPFBC40=PRPFBC40+1
End DoDot:2
+24 IF PFINCFRQ'["D"&(PFINCFRQ'["W")&(PFINCFRQ'["M")&(PFINCFRQ'["Y")&(PFINCFRQ'["X")&(PFINCFRQ'["V")&(PFINCFRQ'["O")&(PFINCFRQ'="")
Begin DoDot:2
+25 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,40,PFNAME_"_"_PRPFHLD1_"_"_"Inc#"_PRPFHLD2)="INCOME FREQUENCY^Income frequency not D,W,M,Y,X,V,O,Blank^"_PFINCFRQ
+26 SET PFMCTR3=PFMCTR3+1
+27 SET CNTERR(40)=CNTERR(40)+1
+28 SET CNTERR(100)=CNTERR(100)+1
End DoDot:2
End DoDot:1
+29 QUIT
KILLIT ;VARIABLES KILLED HERE
+1 KILL CNTBAL,CNTERR,CNTREC,CNTRPSU,CNTSEG,CNTTOT,ND,PARAMS,PFADDR1,PFADDR2
+2 KILL PFADDR3,PFAPPOR,PFARPM,PFARPW,PFAUTH,PFAUTHDT,PFAUTHRS,PFCITY,PFCLAIM,PFDOB
+3 KILL PFG,PFGUARD,PFICNFLG,PFINCFRQ,PFINCOME,PFINCPYE,PFINDIG,PFINSAWD,PFMAX1,PFMCTR1
+4 KILL PFMCTR2,PFMCTR3,PFMIN1,PFNAME,PFNAMEX,PFNODE0,PFNODE1,PFNODE2,PFNODE4,PFNODE4D
+5 KILL PFNODE4X,PFNODE5,PFNODE51,PFNODE52,PFNODE6,PFNODE7,PFNODE8,PFOTRAST,PFPSTAT
+6 KILL PFRGNID,PFSITE,PFSSN,PFSTAID,PFSTAT,PFSTATE,PFSTDBAL,PFSTDGRT,PFSTDPVT,PFSUSDT
+7 KILL PFSUSID,PFSUSTXT,PFTDT,PFTDTE,PFTEMP,PFTYPE,PFWARD,PFX,PFY,PFZ,PFZIP,POP,PRPFBADD
+8 KILL PRPFBBAL,PRPFBDMO,PRPFCNTR,PRPFDEFR,PRPFHLD1,PRPFHLD2,PRPFHLD3,PRPFHLD4,PRPFSEG
+9 KILL X,XION
+10 QUIT
