PRPFDR1 ;BAYPINES/MJE  VPFS DATA MIGRATION ROUTINE 1 ;05/15/03
 ;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989
 ;BAD ENTRY POINT
 Q
NODE4 S PRPFHLD2=0
 F  S PRPFHLD2=$O(^PRPF(470,PRPFHLD1,4,PRPFHLD2)) Q:'PRPFHLD2  D
 .S PFNODE4=^PRPF(470,PRPFHLD1,4,PRPFHLD2,0)
 .I '$D(^PRPF(470.1,+$P(PFNODE4,"^",1),0)) D
 ..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)
 ..S CNTERR(47)=CNTERR(47)+1
 ..S CNTERR(100)=CNTERR(100)+1
 .I $D(^PRPF(470.1,+$P(PFNODE4,"^",1),0)) D
 ..S PFNODE4D=^PRPF(470.1,$P(PFNODE4,"^",1),0)
 ..I PFNODE4D="" D
 ...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)
 ...S CNTERR(47)=CNTERR(47)+1
 ...S CNTERR(100)=CNTERR(100)+1
 ..I PFNODE4D'="" D
 ...I +($P(PFNODE4D,"^",1))'=+$P(PFNODE4,"^",1) D
 ....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)
 ....S CNTERR(47)=CNTERR(47)+1
 ....S CNTERR(100)=CNTERR(100)+1
 ...I $P(PFNODE4D,"^",2)'=PRPFHLD1 D
 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,48,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT NAME^Patient name does not match transaction^"_$P(PFNODE4D,"^",2)
 ....S CNTERR(48)=CNTERR(48)+1
 ....S CNTERR(100)=CNTERR(100)+1
 ...S PFNODE4X=$P(PFNODE4D,"^",3)
 ...I +PFNODE4X'=PFNODE4X!(PFNODE4X>99999)!(PFNODE4X<1) D
 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,49,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT TRANSACTION #^Patient transaction # invalid^"_$P(PFNODE4D,"^",3)
 ....S CNTERR(49)=CNTERR(49)+1
 ....S CNTERR(100)=CNTERR(100)+1
 ...S PFNODE4X=$P(PFNODE4D,"^",4)
 ...I PFNODE4X=""!(+PFNODE4X'=PFNODE4X)&(PFNODE4X'?.N1".".N)!(PFNODE4X>99999)!(PFNODE4X<.01) D
 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,50,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="AMOUNT^Deferred amount invalid^"_$P(PFNODE4D,"^",4)
 ....S CNTERR(50)=CNTERR(50)+1
 ....S CNTERR(100)=CNTERR(100)+1
 ...S PFTDT=$P(PFNODE4D,"^",5)
 ...S PRPFBADD=""
 ...D DT^DILF("X",PFTDT,.PRPFBADD)
 ...I $L(+PFTDT)'=7!(PRPFBADD=-1)!(PRPFBADD="") D
 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,51,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="TRANSACTION DATE^Transaction date Invalid^"_$P(PFNODE4D,"^",5)
 ....S CNTERR(51)=CNTERR(51)+1
 ....S CNTERR(100)=CNTERR(100)+1
 ...S PFTDTE=$P(PFNODE4D,"^",6)
 ...S PRPFBADD=""
 ...D DT^DILF("X",PFTDTE,.PRPFBADD)
 ...I $L(+PFTDTE)'=7!(PRPFBADD=-1)!(PRPFBADD="") D
 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,52,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="DATE TRANSACTION ENTERED^Date transaction entered Invalid^"_$P(PFNODE4D,"^",6)
 ....S CNTERR(52)=CNTERR(52)+1
 ....S CNTERR(100)=CNTERR(100)+1
 ...S PFNODE4X=$P(PFNODE4D,"^",7)
 ...I $L(PFNODE4X)>10!($L(PFNODE4X)<1) D
 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,53,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="REFERENCE^Reference Invalid < 1 or > 10 in length^"_$P(PFNODE4D,"^",7)
 ....S CNTERR(53)=CNTERR(53)+1
 ....S CNTERR(100)=CNTERR(100)+1
 ...S PFNODE4X=$P(PFNODE4D,"^",8)
 ...I PFNODE4X'["D"&(PFNODE4X'["W") D
 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,54,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="DEPOSIT/WITHDRAWAL^Deposit/Withdrawal status Invalid^"_$P(PFNODE4D,"^",8)
 ....S CNTERR(54)=CNTERR(54)+1
 ....S CNTERR(100)=CNTERR(100)+1
 ...S PFNODE4X=$P(PFNODE4D,"^",9)
 ...I PFNODE4X'["1"&(PFNODE4X'["2")&(PFNODE4X'["3") D
 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,55,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="CASH/CHECK/OTHER^Cash/Check/Other status Invalid^"_$P(PFNODE4D,"^",9)
 ....S CNTERR(55)=CNTERR(55)+1
 ....S CNTERR(100)=CNTERR(100)+1
 ...S PFNODE4X=$P(PFNODE4D,"^",10)
 ...I PFNODE4X'["P"&(PFNODE4X'["G")&(PFNODE4X'="B") D
 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,56,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="SOURCE^Transaction source invalid^"_$P(PFNODE4D,"^",10)
 ....S CNTERR(56)=CNTERR(56)+1
 ....S CNTERR(100)=CNTERR(100)+1
 ...I $P(PFNODE4D,"^",11)="" D
 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,57,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="FORM^Form does not match^"_$P(PFNODE4D,"^",11)
 ....S CNTERR(57)=CNTERR(57)+1
 ....S CNTERR(100)=CNTERR(100)+1
 ...I $P(PFNODE4D,"^",11)'="" D
 ....I '$D(^PRPF(470.2,$P(PFNODE4D,"^",11),0)) D
 .....S ^TMP("PRPF_DIAGX",$J,PFSTAID,57,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="FORM^Form does not match^"_$P(PFNODE4D,"^",11)
 .....S CNTERR(57)=CNTERR(57)+1
 .....S CNTERR(100)=CNTERR(100)+1
 ...S PFNODE4X=$P(PFNODE4D,"^",12)
 ...I PFNODE4X'="" I +PFNODE4X'=PFNODE4X&(PFNODE4X'?.N1".".N)!(PFNODE4X>99999)!(PFNODE4X<.01) D
 ....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)
 ....S CNTERR(58)=CNTERR(58)+1
 ....S CNTERR(100)=CNTERR(100)+1
 ...S PFNODE4X=$P(PFNODE4D,"^",13)
 ...I PFNODE4X'="" I +PFNODE4X'=PFNODE4X&(PFNODE4X'?.N1".".N)!(PFNODE4X>99999)!(PFNODE4X<.01) D
 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,59,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="GRATUITOUS AMOUNT^Gratuitous amt invalid or < 0 or > 99999^"_$P(PFNODE4D,"^",13)
 ....S CNTERR(59)=CNTERR(59)+1
 ....S CNTERR(100)=CNTERR(100)+1
 ...S PFNODE4X=$P(PFNODE4D,"^",14)
 ...I PFNODE4X'="" D
 ....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
 .....S ^TMP("PRPF_DIAGX",$J,PFSTAID,60,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT FUNDS CLERK^Pfunds clerk invalid^"_$P($G(^VA(200,PFNODE4X,0)),"^",1)
 .....S CNTERR(60)=CNTERR(60)+1
 .....S CNTERR(100)=CNTERR(100)+1
 ...I PFNODE4X="" D
 ....S ^TMP("PRPF_DIAGX",$J,PFSTAID,60,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT FUNDS CLERK^Pfunds clerk invalid^"_""
 ....S CNTERR(60)=CNTERR(60)+1
 ....S CNTERR(100)=CNTERR(100)+1
 .S PRPFDEFR=PRPFDEFR+1
 Q
NODE5 S (PRPFHLD2,PRPFHLD3,PRPFHLD4)=0
 F  S PRPFHLD2=$O(^PRPF(470,PRPFHLD1,5,PRPFHLD2)) Q:'PRPFHLD2  D
 .S PFNODE5=$G(^PRPF(470,PRPFHLD1,5,PRPFHLD2,0))
 .S PFSUSDT=$P(PFNODE5,"^",1)
 .I PFSUSDT="" D
 ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,43.1,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2)="SUSPENSE DATE^Suspense date is blank^"_PFSUSDT
 ..S CNTERR(43)=CNTERR(43)+1
 ..S CNTERR(100)=CNTERR(100)+1
 .ELSE  D
 ..K PRPFBADD
 ..D DT^DILF("X",PFSUSDT,.PRPFBADD)
 ..I $L(+PFSUSDT)'=7!(PRPFBADD=-1) D
 ...S ^TMP("PRPF_DIAGX",$J,PFSTAID,43.2,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2)="SUSPENSE DATE^Suspense date is not valid^"_PFSUSDT
 ...S CNTERR(43)=CNTERR(43)+1
 ...S CNTERR(100)=CNTERR(100)+1
 .F  S PRPFHLD3=$O(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3)) Q:'PRPFHLD3  D
 ..S PFNODE51=$G(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3,0))
 ..S PFSUSID=PFNODE51
 ..I PFSUSID="" D
 ...S ^TMP("PRPF_DIAGX",$J,PFSTAID,44.1,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE ID^Suspense ID is blank^"_PFSUSID
 ...S CNTERR(44)=CNTERR(44)+1
 ...S CNTERR(100)=CNTERR(100)+1
 ..I PFSUSID'="" I $L(PFSUSID)<1!($L(PFSUSID)>40) D
 ...S ^TMP("PRPF_DIAGX",$J,PFSTAID,44.2,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE ID^Suspense ID < 1 or > 40 characters^"_PFSUSID
 ...S CNTERR(44)=CNTERR(44)+1
 ...S CNTERR(100)=CNTERR(100)+1
 ..S PFSUSTXT=""
 ..F  S PRPFHLD4=$O(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3,1,PRPFHLD4)) Q:'PRPFHLD4  D
 ...S PFNODE52=$G(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3,1,PRPFHLD4,0))
 ...S PFSUSTXT=PFSUSTXT_PFNODE52
 ..I PFSUSTXT="" D
 ...S ^TMP("PRPF_DIAGX",$J,PFSTAID,45.1,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE DESC^Suspense description is blank^"_PFSUSTXT
 ...S CNTERR(45)=CNTERR(45)+1
 ...S CNTERR(100)=CNTERR(100)+1
 ..I PFSUSTXT'="" I $L(PFSUSTXT)<1!($L(PFSUSTXT)>255) D
 ...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)
 ...S CNTERR(45)=CNTERR(45)+1
 ...S CNTERR(100)=CNTERR(100)+1
 ..S PRPFHLD4=0
 .S PRPFHLD3=0
 Q
NODE12 I $G(^PRPF(470,PRPFHLD1,12))'="" D
 .I '$D(^DIC(4,^PRPF(470,PRPFHLD1,12),99))!(PFSTAID="ERRBADID")!(PFSTAID="ERRBADID1") D
 ..S ^TMP("PRPF_DIAGX",$J,PFSTAID,42,PFNAME_"_"_PRPFHLD1)="STATIONID^STATION ID INVALID^"_PFSTAID
 ..S CNTERR(42)=CNTERR(42)+1
 ..S CNTERR(100)=CNTERR(100)+1
 S:$G(^PRPF(470,PRPFHLD1,12))="" PFSTAID="UNASSIGNED"
NODE12X I PFSTAID=""!(PFSTAID="UNASSIGNED")!(PFSTAID="ERRNOID")!(PFSTAID="ERRNOID1") D
 .S:PFSTAID="" PFSTAID="UNASSIGNED"
 .S CNTERR(41)=CNTERR(41)+1
 .S CNTERR(100)=CNTERR(100)+1
 Q