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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFDR1 8839 printed Nov 22, 2024@17:11:39 Page 2
PRPFDR1 ;BAYPINES/MJE VPFS DATA MIGRATION ROUTINE 1 ;05/15/03
+1 ;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989
+2 ;BAD ENTRY POINT
+3 QUIT
NODE4 SET PRPFHLD2=0
+1 FOR
SET PRPFHLD2=$ORDER(^PRPF(470,PRPFHLD1,4,PRPFHLD2))
if 'PRPFHLD2
QUIT
Begin DoDot:1
+2 SET PFNODE4=^PRPF(470,PRPFHLD1,4,PRPFHLD2,0)
+3 IF '$DATA(^PRPF(470.1,+$PIECE(PFNODE4,"^",1),0))
Begin DoDot:2
+4 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,47,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="TRANSACTION REC^Transaction record missing, blank or ID invalid (Transaction missing)^"_$PIECE(PFNODE4,"^",1)
+5 SET CNTERR(47)=CNTERR(47)+1
+6 SET CNTERR(100)=CNTERR(100)+1
End DoDot:2
+7 IF $DATA(^PRPF(470.1,+$PIECE(PFNODE4,"^",1),0))
Begin DoDot:2
+8 SET PFNODE4D=^PRPF(470.1,$PIECE(PFNODE4,"^",1),0)
+9 IF PFNODE4D=""
Begin DoDot:3
+10 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,47,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="TRANSACTION REC^Transaction record missing, blank or ID invalid (Record blank)^"_$PIECE(PFNODE4,"^",1)
+11 SET CNTERR(47)=CNTERR(47)+1
+12 SET CNTERR(100)=CNTERR(100)+1
End DoDot:3
+13 IF PFNODE4D'=""
Begin DoDot:3
+14 IF +($PIECE(PFNODE4D,"^",1))'=+$PIECE(PFNODE4,"^",1)
Begin DoDot:4
+15 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,47,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="TRANSACTION REC^Transaction record missing, blank or ID invalid (Transaction ID does not match IEN)^"_$PIECE(PFNODE4,"^",1)
+16 SET CNTERR(47)=CNTERR(47)+1
+17 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
+18 IF $PIECE(PFNODE4D,"^",2)'=PRPFHLD1
Begin DoDot:4
+19 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,48,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT NAME^Patient name does not match transaction^"_$PIECE(PFNODE4D,"^",2)
+20 SET CNTERR(48)=CNTERR(48)+1
+21 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
+22 SET PFNODE4X=$PIECE(PFNODE4D,"^",3)
+23 IF +PFNODE4X'=PFNODE4X!(PFNODE4X>99999)!(PFNODE4X<1)
Begin DoDot:4
+24 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,49,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT TRANSACTION #^Patient transaction # invalid^"_$PIECE(PFNODE4D,"^",3)
+25 SET CNTERR(49)=CNTERR(49)+1
+26 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
+27 SET PFNODE4X=$PIECE(PFNODE4D,"^",4)
+28 IF PFNODE4X=""!(+PFNODE4X'=PFNODE4X)&(PFNODE4X'?.N1".".N)!(PFNODE4X>99999)!(PFNODE4X<.01)
Begin DoDot:4
+29 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,50,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="AMOUNT^Deferred amount invalid^"_$PIECE(PFNODE4D,"^",4)
+30 SET CNTERR(50)=CNTERR(50)+1
+31 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
+32 SET PFTDT=$PIECE(PFNODE4D,"^",5)
+33 SET PRPFBADD=""
+34 DO DT^DILF("X",PFTDT,.PRPFBADD)
+35 IF $LENGTH(+PFTDT)'=7!(PRPFBADD=-1)!(PRPFBADD="")
Begin DoDot:4
+36 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,51,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="TRANSACTION DATE^Transaction date Invalid^"_$PIECE(PFNODE4D,"^",5)
+37 SET CNTERR(51)=CNTERR(51)+1
+38 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
+39 SET PFTDTE=$PIECE(PFNODE4D,"^",6)
+40 SET PRPFBADD=""
+41 DO DT^DILF("X",PFTDTE,.PRPFBADD)
+42 IF $LENGTH(+PFTDTE)'=7!(PRPFBADD=-1)!(PRPFBADD="")
Begin DoDot:4
+43 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,52,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="DATE TRANSACTION ENTERED^Date transaction entered Invalid^"_$PIECE(PFNODE4D,"^",6)
+44 SET CNTERR(52)=CNTERR(52)+1
+45 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
+46 SET PFNODE4X=$PIECE(PFNODE4D,"^",7)
+47 IF $LENGTH(PFNODE4X)>10!($LENGTH(PFNODE4X)<1)
Begin DoDot:4
+48 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,53,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="REFERENCE^Reference Invalid < 1 or > 10 in length^"_$PIECE(PFNODE4D,"^",7)
+49 SET CNTERR(53)=CNTERR(53)+1
+50 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
+51 SET PFNODE4X=$PIECE(PFNODE4D,"^",8)
+52 IF PFNODE4X'["D"&(PFNODE4X'["W")
Begin DoDot:4
+53 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,54,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="DEPOSIT/WITHDRAWAL^Deposit/Withdrawal status Invalid^"_$PIECE(PFNODE4D,"^",8)
+54 SET CNTERR(54)=CNTERR(54)+1
+55 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
+56 SET PFNODE4X=$PIECE(PFNODE4D,"^",9)
+57 IF PFNODE4X'["1"&(PFNODE4X'["2")&(PFNODE4X'["3")
Begin DoDot:4
+58 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,55,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="CASH/CHECK/OTHER^Cash/Check/Other status Invalid^"_$PIECE(PFNODE4D,"^",9)
+59 SET CNTERR(55)=CNTERR(55)+1
+60 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
+61 SET PFNODE4X=$PIECE(PFNODE4D,"^",10)
+62 IF PFNODE4X'["P"&(PFNODE4X'["G")&(PFNODE4X'="B")
Begin DoDot:4
+63 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,56,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="SOURCE^Transaction source invalid^"_$PIECE(PFNODE4D,"^",10)
+64 SET CNTERR(56)=CNTERR(56)+1
+65 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
+66 IF $PIECE(PFNODE4D,"^",11)=""
Begin DoDot:4
+67 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,57,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="FORM^Form does not match^"_$PIECE(PFNODE4D,"^",11)
+68 SET CNTERR(57)=CNTERR(57)+1
+69 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
+70 IF $PIECE(PFNODE4D,"^",11)'=""
Begin DoDot:4
+71 IF '$DATA(^PRPF(470.2,$PIECE(PFNODE4D,"^",11),0))
Begin DoDot:5
+72 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,57,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="FORM^Form does not match^"_$PIECE(PFNODE4D,"^",11)
+73 SET CNTERR(57)=CNTERR(57)+1
+74 SET CNTERR(100)=CNTERR(100)+1
End DoDot:5
End DoDot:4
+75 SET PFNODE4X=$PIECE(PFNODE4D,"^",12)
+76 IF PFNODE4X'=""
IF +PFNODE4X'=PFNODE4X&(PFNODE4X'?.N1".".N)!(PFNODE4X>99999)!(PFNODE4X<.01)
Begin DoDot:4
+77 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,58,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PRIVATE SOURCE AMT^Pvt src amt invalid or < 0 or > 99999^"_$PIECE(PFNODE4D,"^",12)
+78 SET CNTERR(58)=CNTERR(58)+1
+79 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
+80 SET PFNODE4X=$PIECE(PFNODE4D,"^",13)
+81 IF PFNODE4X'=""
IF +PFNODE4X'=PFNODE4X&(PFNODE4X'?.N1".".N)!(PFNODE4X>99999)!(PFNODE4X<.01)
Begin DoDot:4
+82 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,59,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="GRATUITOUS AMOUNT^Gratuitous amt invalid or < 0 or > 99999^"_$PIECE(PFNODE4D,"^",13)
+83 SET CNTERR(59)=CNTERR(59)+1
+84 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
+85 SET PFNODE4X=$PIECE(PFNODE4D,"^",14)
+86 IF PFNODE4X'=""
Begin DoDot:4
+87 IF '$DATA(^VA(200,PFNODE4X,0))!($LENGTH($PIECE($GET(^VA(200,PFNODE4X,0)),"^",1))<3!($LENGTH($PIECE($GET(^VA(200,PFNODE4X,0)),"^",1))>35))
Begin DoDot:5
+88 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,60,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT FUNDS CLERK^Pfunds clerk invalid^"_$PIECE($GET(^VA(200,PFNODE4X,0)),"^",1)
+89 SET CNTERR(60)=CNTERR(60)+1
+90 SET CNTERR(100)=CNTERR(100)+1
End DoDot:5
End DoDot:4
+91 IF PFNODE4X=""
Begin DoDot:4
+92 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,60,PFNAME_"_"_PRPFHLD1_"_"_"DefTrans#"_PRPFHLD2)="PATIENT FUNDS CLERK^Pfunds clerk invalid^"_""
+93 SET CNTERR(60)=CNTERR(60)+1
+94 SET CNTERR(100)=CNTERR(100)+1
End DoDot:4
End DoDot:3
End DoDot:2
+95 SET PRPFDEFR=PRPFDEFR+1
End DoDot:1
+96 QUIT
NODE5 SET (PRPFHLD2,PRPFHLD3,PRPFHLD4)=0
+1 FOR
SET PRPFHLD2=$ORDER(^PRPF(470,PRPFHLD1,5,PRPFHLD2))
if 'PRPFHLD2
QUIT
Begin DoDot:1
+2 SET PFNODE5=$GET(^PRPF(470,PRPFHLD1,5,PRPFHLD2,0))
+3 SET PFSUSDT=$PIECE(PFNODE5,"^",1)
+4 IF PFSUSDT=""
Begin DoDot:2
+5 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,43.1,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2)="SUSPENSE DATE^Suspense date is blank^"_PFSUSDT
+6 SET CNTERR(43)=CNTERR(43)+1
+7 SET CNTERR(100)=CNTERR(100)+1
End DoDot:2
+8 IF '$TEST
Begin DoDot:2
+9 KILL PRPFBADD
+10 DO DT^DILF("X",PFSUSDT,.PRPFBADD)
+11 IF $LENGTH(+PFSUSDT)'=7!(PRPFBADD=-1)
Begin DoDot:3
+12 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,43.2,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2)="SUSPENSE DATE^Suspense date is not valid^"_PFSUSDT
+13 SET CNTERR(43)=CNTERR(43)+1
+14 SET CNTERR(100)=CNTERR(100)+1
End DoDot:3
End DoDot:2
+15 FOR
SET PRPFHLD3=$ORDER(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3))
if 'PRPFHLD3
QUIT
Begin DoDot:2
+16 SET PFNODE51=$GET(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3,0))
+17 SET PFSUSID=PFNODE51
+18 IF PFSUSID=""
Begin DoDot:3
+19 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,44.1,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE ID^Suspense ID is blank^"_PFSUSID
+20 SET CNTERR(44)=CNTERR(44)+1
+21 SET CNTERR(100)=CNTERR(100)+1
End DoDot:3
+22 IF PFSUSID'=""
IF $LENGTH(PFSUSID)<1!($LENGTH(PFSUSID)>40)
Begin DoDot:3
+23 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,44.2,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE ID^Suspense ID < 1 or > 40 characters^"_PFSUSID
+24 SET CNTERR(44)=CNTERR(44)+1
+25 SET CNTERR(100)=CNTERR(100)+1
End DoDot:3
+26 SET PFSUSTXT=""
+27 FOR
SET PRPFHLD4=$ORDER(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3,1,PRPFHLD4))
if 'PRPFHLD4
QUIT
Begin DoDot:3
+28 SET PFNODE52=$GET(^PRPF(470,PRPFHLD1,5,PRPFHLD2,1,PRPFHLD3,1,PRPFHLD4,0))
+29 SET PFSUSTXT=PFSUSTXT_PFNODE52
End DoDot:3
+30 IF PFSUSTXT=""
Begin DoDot:3
+31 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,45.1,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE DESC^Suspense description is blank^"_PFSUSTXT
+32 SET CNTERR(45)=CNTERR(45)+1
+33 SET CNTERR(100)=CNTERR(100)+1
End DoDot:3
+34 IF PFSUSTXT'=""
IF $LENGTH(PFSUSTXT)<1!($LENGTH(PFSUSTXT)>255)
Begin DoDot:3
+35 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,45.2,PFNAME_"_"_PRPFHLD1_"_"_"SuspenseDate#"_PRPFHLD2_"_Item#"_PRPFHLD3)="SUSPENSE DESC^Suspense description < 1 or > 255 characters^"_"SUSPENSE ID="_PFSUSID_", DESCRIPTION LENGTH="
_$LENGTH(PFSUSTXT)
+36 SET CNTERR(45)=CNTERR(45)+1
+37 SET CNTERR(100)=CNTERR(100)+1
End DoDot:3
+38 SET PRPFHLD4=0
End DoDot:2
+39 SET PRPFHLD3=0
End DoDot:1
+40 QUIT
NODE12 IF $GET(^PRPF(470,PRPFHLD1,12))'=""
Begin DoDot:1
+1 IF '$DATA(^DIC(4,^PRPF(470,PRPFHLD1,12),99))!(PFSTAID="ERRBADID")!(PFSTAID="ERRBADID1")
Begin DoDot:2
+2 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,42,PFNAME_"_"_PRPFHLD1)="STATIONID^STATION ID INVALID^"_PFSTAID
+3 SET CNTERR(42)=CNTERR(42)+1
+4 SET CNTERR(100)=CNTERR(100)+1
End DoDot:2
End DoDot:1
+5 if $GET(^PRPF(470,PRPFHLD1,12))=""
SET PFSTAID="UNASSIGNED"
NODE12X IF PFSTAID=""!(PFSTAID="UNASSIGNED")!(PFSTAID="ERRNOID")!(PFSTAID="ERRNOID1")
Begin DoDot:1
+1 if PFSTAID=""
SET PFSTAID="UNASSIGNED"
+2 SET CNTERR(41)=CNTERR(41)+1
+3 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+4 QUIT
