PRPFDR5 ;BAYPINES/MJE VPFS DATA MIGRATION ROUTINE 5 ;05/15/03
;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989
;BAD ENTRY POINT
Q
NODE0 S PFNODE0=^PRPF(470,PRPFHLD1,0)
S PFNAMEX=""
S PFNAMEX=PFNAME
I PFNAME=""!($E(PFNAME,1,12)="NAME-MISSING") D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,1,PFNAME_"_"_PRPFHLD1)="NAME^Name is blank^"_PFNAME
.S CNTERR(1)=CNTERR(1)+1
.S CNTERR(100)=CNTERR(100)+1
ELSE I $$FORMAT^XLFNAME7(PFNAMEX,3,30)'=PFNAMEX D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,2,PFNAME_"_"_PRPFHLD1)="NAME^Patient Name contains invalid data^"_PFNAME
.S CNTERR(2)=CNTERR(2)+1
.S CNTERR(100)=CNTERR(100)+1
I PFSSN="" D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,3,PFNAME_"_"_PRPFHLD1)="SSN^SSN is blank^"_PFSSN
.S CNTERR(3)=CNTERR(3)+1
.S CNTERR(100)=CNTERR(100)+1
I PFSSN'="" D
.I $L(PFSSN)<9!($L(PFSSN)>10) D
..S ^TMP("PRPF_DIAGX",$J,PFSTAID,4,PFNAME_"_"_PRPFHLD1)="SSN^SSN that is not 9 digits or has non-numeric values^"_PFSSN
..S CNTERR(4)=CNTERR(4)+1
..S CNTERR(100)=CNTERR(100)+1
.I $L(PFSSN)=9 D
..I '(PFSSN?.9N) D
...S ^TMP("PRPF_DIAGX",$J,PFSTAID,4.1,PFNAME_"_"_PRPFHLD1)="SSN^SSN that is not 9 digits or has non-numeric values^"_PFSSN
...S CNTERR(4)=CNTERR(4)+1
...S CNTERR(100)=CNTERR(100)+1
.I $L(PFSSN)=10 D
..I ($E(PFSSN,1,9)?.9N)&($E(PFSSN,10,10)="P") D
...S ^TMP("PRPF_DIAGX",$J,PFSTAID,6,PFNAME_"_"_PRPFHLD1)="SSN^PSEUDO SSN value^"_PFSSN
...S CNTRPSU=CNTRPSU+1
..I '($E(PFSSN,1,9)?.9N)!($E(PFSSN,10,10)'="P") D
...S ^TMP("PRPF_DIAGX",$J,PFSTAID,4.2,PFNAME_"_"_PRPFHLD1)="SSN^SSN that is not 9 digits or has non-numeric values^"_PFSSN
...S CNTERR(4)=CNTERR(4)+1
...S CNTERR(100)=CNTERR(100)+1
I PFSSN'="" D
.I $D(^TMP("PRPF_DIAGX",$J,"PFSSN",PFSSN)) D
..S ^TMP("PRPF_DIAGX",$J,PFSTAID,5,PFNAME_"_"_PRPFHLD1)="SSN^SSN duplicate value^"_PFSSN
..S CNTERR(5)=CNTERR(5)+1
..S CNTERR(100)=CNTERR(100)+1
.S ^TMP("PRPF_DIAGX",$J,"PFSSN",PFSSN)=PFSSN
I PFDOB="" D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,7,PFNAME_"_"_PRPFHLD1)="DOB^DOB blank^"_PFDOB
.S CNTERR(7)=CNTERR(7)+1
.S CNTERR(100)=CNTERR(100)+1
ELSE D
.K PRPFBADD
.D DT^DILF("X",PFDOB,.PRPFBADD)
.I $L(+PFDOB)'=7!(PRPFBADD=-1) D
..S ^TMP("PRPF_DIAGX",$J,PFSTAID,8,PFNAME_"_"_PRPFHLD1)="DOB^DOB contains invalid date^"_PFDOB
..S CNTERR(8)=CNTERR(8)+1
..S CNTERR(100)=CNTERR(100)+1
I PFWARD'="" I $L(PFWARD)>30!($L(PFWARD)<2) D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,9,PFNAME_"_"_PRPFHLD1)="WARD^Ward loc invalid length not 2 TO 30^"_PFWARD
.S CNTERR(9)=CNTERR(9)+1
.S CNTERR(100)=CNTERR(100)+1
I PFCLAIM=""!(PFCLAIM="SS") D
.;S ^TMP("PRPF_DIAGX",$J,PFSTAID,8,PFNAME_"_"_PRPFHLD1)="CLAIM#^Claim # blank^"_PFCLAIM
.;S CNTERR(8)=CNTERR(8)+1
.;S CNTERR(100)=CNTERR(100)+1
ELSE I $L(PFCLAIM)<7!($L(PFCLAIM)>9)!'(PFCLAIM?.N) D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,10,PFNAME_"_"_PRPFHLD1)="CLAIM#^Claim # < 7 or > 9 digits or non-numeric^"_PFCLAIM
.S CNTERR(10)=CNTERR(10)+1
.S CNTERR(100)=CNTERR(100)+1
I PFSTATE="" D
.;S ^TMP("PRPF_DIAGX",$J,PFSTAID,10,PFNAME_"_"_PRPFHLD1)="STATE^STATE field is blank^"_PFSTATE
.;S CNTERR(10)=CNTERR(10)+1
.;S CNTERR(100)=CNTERR(100)+1
I PFZIP="" D
.;S ^TMP("PRPF_DIAGX",$J,PFSTAID,11,PFNAME_"_"_PRPFHLD1)="ZIPCODE#^ZIPCODE blank^"_PFZIP
.;S CNTERR(11)=CNTERR(11)+1
.;S CNTERR(100)=CNTERR(100)+1
ELSE I $L(PFZIP)>5!($L(PFZIP)<5)!'(PFZIP?5N) D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,11,PFNAME_"_"_PRPFHLD1)="ZIPCODE#^ZIPCODE < or > 5 digits or non-numeric^"_PFZIP
.S CNTERR(11)=CNTERR(11)+1
.S CNTERR(100)=CNTERR(100)+1
S PFRGNID=""
S PFICNFLG=$$GETICN^MPIF001(PRPFHLD1)
I +PFICNFLG'=-1 D
.I $D(^TMP("PRPF_DIAGX",$J,"PFICN",+PFICNFLG)) D
..S ^TMP("PRPF_DIAGX",$J,PFSTAID,13,PFNAME_"_"_PRPFHLD1)="ICN^ICN Duplicate^"_PFICNFLG
..S CNTERR(13)=CNTERR(13)+1
..S CNTERR(100)=CNTERR(100)+1
.S ^TMP("PRPF_DIAGX",$J,"PFICN",+PFICNFLG)=PFICNFLG
I +PFICNFLG=-1 D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,14,PFNAME_"_"_PRPFHLD1)="ICN^ICN Unassigned or invalid^"_$P(PFICNFLG,"^",2)
.S CNTERR(14)=CNTERR(14)+1
.S CNTERR(100)=CNTERR(100)+1
.;S PRPFBJOB=$$MPIQQ^MPIFAPI(PRPFHLD1)
S (PFAUTHRS,PFNAMEX)=""
I PFAUTH'="" D
.S (PFAUTHRS,PFNAMEX)=$P($G(^VA(200,PFAUTH,0)),"^",1)
.I $$FORMAT^XLFNAME7(PFNAMEX,3,30)'=PFNAMEX!('$D(^VA(200,PFAUTH,0))) D
..S ^TMP("PRPF_DIAGX",$J,PFSTAID,15,PFNAME_"_"_PRPFHLD1)="PFAUTHRS^Provider name contains invalid data^"_PFAUTHRS
..S CNTERR(15)=CNTERR(15)+1
..S CNTERR(100)=CNTERR(100)+1
S PFAUTHDT=$P(^PRPF(470,PRPFHLD1,0),"^",12)
I PFAUTHDT'="" D
.K PRPFBADD
.D DT^DILF("X",PFAUTHDT,.PRPFBADD)
.I $L(+PFAUTHDT)'=7!(PRPFBADD=-1) D
..S ^TMP("PRPF_DIAGX",$J,PFSTAID,16,PFNAME_"_"_PRPFHLD1)="PROVAUTHDT^Date of current restriction contains invalid date^"_PFAUTHDT
..S CNTERR(16)=CNTERR(16)+1
..S CNTERR(100)=CNTERR(100)+1
S PFSTAT=$P(PFNODE0,"^",2)
I PFSTAT="" D
.S PRPFBC18=PRPFBC18+1
I PFSTAT'["A"&(PFSTAT'["I")&(PFSTAT'="") D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,18,PFNAME_"_"_PRPFHLD1)="ACCOUNT STATUS^Account status containing values other than A or I^"_PFSTAT
.S CNTERR(18)=CNTERR(18)+1
.S CNTERR(100)=CNTERR(100)+1
S PFTYPE=$P(PFNODE0,"^",3)
I PFTYPE="" D
.S PRPFBC19=PRPFBC19+1
I PFTYPE'["L"&(PFTYPE'["R")&(PFTYPE'["U")&(PFTYPE'["X")&(PFTYPE'="") D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,19,PFNAME_"_"_PRPFHLD1)="PATIENT TYPE^Patient type values other than L, R, U, X^"_PFTYPE
.S CNTERR(19)=CNTERR(19)+1
.S CNTERR(100)=CNTERR(100)+1
I (PFAUTH=""&(PFTYPE="L"))!(PFAUTH=""&(PFTYPE="R")) D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,20,PFNAME_"_"_PRPFHLD1)="PATIENT TYPE/PHY^No Physician name for L or R^"_PFTYPE
.S CNTERR(20)=CNTERR(20)+1
.S CNTERR(100)=CNTERR(100)+1
S PFPSTAT=$P(PFNODE0,"^",4)
I PFPSTAT="" D
.S PRPFBC21=PRPFBC21+1
I PFPSTAT'["A"&(PFPSTAT'["R")&(PFPSTAT'["C")&(PFPSTAT'["N")&(PFPSTAT'["X")&(PFPSTAT'="") D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,21,PFNAME_"_"_PRPFHLD1)="PATIENT STATUS^Patient status values other than A, R, C, N, X^"_PFPSTAT
.S CNTERR(21)=CNTERR(21)+1
.S CNTERR(100)=CNTERR(100)+1
S PFINDIG=$P(PFNODE0,"^",5)
I PFINDIG="" D
.S PRPFBC22=PRPFBC22+1
I PFINDIG'["Y"&(PFINDIG'["N")&(PFINDIG'="") D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,22,PFNAME_"_"_PRPFHLD1)="INDIGENT^Indigent indicator values other than Y, N^"_PFINDIG
.S CNTERR(22)=CNTERR(22)+1
.S CNTERR(100)=CNTERR(100)+1
S PFAPPOR=$P(PFNODE0,"^",6)
I PFAPPOR'="" I PFAPPOR<0!(PFAPPOR>99999)!((PFAPPOR'=+PFAPPOR)&(PFAPPOR'?.N1".".N)) D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,23,PFNAME_"_"_PRPFHLD1)="APPORTIONEE $^Apportionee amount invalid or out of range either < 0 or > $99,999.00^"_PFAPPOR
.S CNTERR(23)=CNTERR(23)+1
.S CNTERR(100)=CNTERR(100)+1
S PFGUARD=$P(PFNODE0,"^",7)
I PFGUARD'="" I PFGUARD<0!(PFGUARD>99999)!((PFGUARD'=+PFGUARD)&(PFGUARD'?.N1".".N)) D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,24,PFNAME_"_"_PRPFHLD1)="GUARDIAN $^Guardian amount invalid or out of range either < 0 or > $99,999.00^"_PFGUARD
.S CNTERR(24)=CNTERR(24)+1
.S CNTERR(100)=CNTERR(100)+1
S PFINSAWD=$P(PFNODE0,"^",8)
I PFINSAWD'="" I PFINSAWD<0!(PFINSAWD>99999)!((PFINSAWD'=+PFINSAWD)&(PFINSAWD'?.N1".".N)) D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,25,PFNAME_"_"_PRPFHLD1)="INSTITUTIONAL AWARD^Institutional award invalid or out of range either < 0 or > $99,999.00^"_PFINSAWD
.S CNTERR(25)=CNTERR(25)+1
.S CNTERR(100)=CNTERR(100)+1
S PFOTRAST=$P(PFNODE0,"^",10)
I PFOTRAST'="" I PFOTRAST<0!(PFOTRAST>99999)!((PFOTRAST'=+PFOTRAST)&(PFOTRAST'?.N1".".N)) D
.S ^TMP("PRPF_DIAGX",$J,PFSTAID,26,PFNAME_"_"_PRPFHLD1)="OTHER ASSETS^Other assets invalid or out of range either < 0 or > $99,999.00^"_PFOTRAST
.S CNTERR(26)=CNTERR(26)+1
.S CNTERR(100)=CNTERR(100)+1
Q
NODE0X S ^TMP("PRPF_DIAGX",$J,PFSTAID,17,PFNAME_"_"_PRPFHLD1)="NO DEMO RECORD^No demographic record for account^"_PFNAME
S CNTERR(17)=CNTERR(17)+1
S CNTERR(100)=CNTERR(100)+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFDR5 7826 printed Apr 09, 2024@21:04:39 Page 2
PRPFDR5 ;BAYPINES/MJE VPFS DATA MIGRATION ROUTINE 5 ;05/15/03
+1 ;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989
+2 ;BAD ENTRY POINT
+3 QUIT
NODE0 SET PFNODE0=^PRPF(470,PRPFHLD1,0)
+1 SET PFNAMEX=""
+2 SET PFNAMEX=PFNAME
+3 IF PFNAME=""!($EXTRACT(PFNAME,1,12)="NAME-MISSING")
Begin DoDot:1
+4 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,1,PFNAME_"_"_PRPFHLD1)="NAME^Name is blank^"_PFNAME
+5 SET CNTERR(1)=CNTERR(1)+1
+6 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+7 IF '$TEST
IF $$FORMAT^XLFNAME7(PFNAMEX,3,30)'=PFNAMEX
Begin DoDot:1
+8 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,2,PFNAME_"_"_PRPFHLD1)="NAME^Patient Name contains invalid data^"_PFNAME
+9 SET CNTERR(2)=CNTERR(2)+1
+10 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+11 IF PFSSN=""
Begin DoDot:1
+12 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,3,PFNAME_"_"_PRPFHLD1)="SSN^SSN is blank^"_PFSSN
+13 SET CNTERR(3)=CNTERR(3)+1
+14 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+15 IF PFSSN'=""
Begin DoDot:1
+16 IF $LENGTH(PFSSN)<9!($LENGTH(PFSSN)>10)
Begin DoDot:2
+17 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,4,PFNAME_"_"_PRPFHLD1)="SSN^SSN that is not 9 digits or has non-numeric values^"_PFSSN
+18 SET CNTERR(4)=CNTERR(4)+1
+19 SET CNTERR(100)=CNTERR(100)+1
End DoDot:2
+20 IF $LENGTH(PFSSN)=9
Begin DoDot:2
+21 IF '(PFSSN?.9N)
Begin DoDot:3
+22 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,4.1,PFNAME_"_"_PRPFHLD1)="SSN^SSN that is not 9 digits or has non-numeric values^"_PFSSN
+23 SET CNTERR(4)=CNTERR(4)+1
+24 SET CNTERR(100)=CNTERR(100)+1
End DoDot:3
End DoDot:2
+25 IF $LENGTH(PFSSN)=10
Begin DoDot:2
+26 IF ($EXTRACT(PFSSN,1,9)?.9N)&($EXTRACT(PFSSN,10,10)="P")
Begin DoDot:3
+27 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,6,PFNAME_"_"_PRPFHLD1)="SSN^PSEUDO SSN value^"_PFSSN
+28 SET CNTRPSU=CNTRPSU+1
End DoDot:3
+29 IF '($EXTRACT(PFSSN,1,9)?.9N)!($EXTRACT(PFSSN,10,10)'="P")
Begin DoDot:3
+30 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,4.2,PFNAME_"_"_PRPFHLD1)="SSN^SSN that is not 9 digits or has non-numeric values^"_PFSSN
+31 SET CNTERR(4)=CNTERR(4)+1
+32 SET CNTERR(100)=CNTERR(100)+1
End DoDot:3
End DoDot:2
End DoDot:1
+33 IF PFSSN'=""
Begin DoDot:1
+34 IF $DATA(^TMP("PRPF_DIAGX",$JOB,"PFSSN",PFSSN))
Begin DoDot:2
+35 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,5,PFNAME_"_"_PRPFHLD1)="SSN^SSN duplicate value^"_PFSSN
+36 SET CNTERR(5)=CNTERR(5)+1
+37 SET CNTERR(100)=CNTERR(100)+1
End DoDot:2
+38 SET ^TMP("PRPF_DIAGX",$JOB,"PFSSN",PFSSN)=PFSSN
End DoDot:1
+39 IF PFDOB=""
Begin DoDot:1
+40 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,7,PFNAME_"_"_PRPFHLD1)="DOB^DOB blank^"_PFDOB
+41 SET CNTERR(7)=CNTERR(7)+1
+42 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+43 IF '$TEST
Begin DoDot:1
+44 KILL PRPFBADD
+45 DO DT^DILF("X",PFDOB,.PRPFBADD)
+46 IF $LENGTH(+PFDOB)'=7!(PRPFBADD=-1)
Begin DoDot:2
+47 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,8,PFNAME_"_"_PRPFHLD1)="DOB^DOB contains invalid date^"_PFDOB
+48 SET CNTERR(8)=CNTERR(8)+1
+49 SET CNTERR(100)=CNTERR(100)+1
End DoDot:2
End DoDot:1
+50 IF PFWARD'=""
IF $LENGTH(PFWARD)>30!($LENGTH(PFWARD)<2)
Begin DoDot:1
+51 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,9,PFNAME_"_"_PRPFHLD1)="WARD^Ward loc invalid length not 2 TO 30^"_PFWARD
+52 SET CNTERR(9)=CNTERR(9)+1
+53 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+54 IF PFCLAIM=""!(PFCLAIM="SS")
Begin DoDot:1
+55 ;S ^TMP("PRPF_DIAGX",$J,PFSTAID,8,PFNAME_"_"_PRPFHLD1)="CLAIM#^Claim # blank^"_PFCLAIM
+56 ;S CNTERR(8)=CNTERR(8)+1
+57 ;S CNTERR(100)=CNTERR(100)+1
End DoDot:1
+58 IF '$TEST
IF $LENGTH(PFCLAIM)<7!($LENGTH(PFCLAIM)>9)!'(PFCLAIM?.N)
Begin DoDot:1
+59 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,10,PFNAME_"_"_PRPFHLD1)="CLAIM#^Claim # < 7 or > 9 digits or non-numeric^"_PFCLAIM
+60 SET CNTERR(10)=CNTERR(10)+1
+61 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+62 IF PFSTATE=""
Begin DoDot:1
+63 ;S ^TMP("PRPF_DIAGX",$J,PFSTAID,10,PFNAME_"_"_PRPFHLD1)="STATE^STATE field is blank^"_PFSTATE
+64 ;S CNTERR(10)=CNTERR(10)+1
+65 ;S CNTERR(100)=CNTERR(100)+1
End DoDot:1
+66 IF PFZIP=""
Begin DoDot:1
+67 ;S ^TMP("PRPF_DIAGX",$J,PFSTAID,11,PFNAME_"_"_PRPFHLD1)="ZIPCODE#^ZIPCODE blank^"_PFZIP
+68 ;S CNTERR(11)=CNTERR(11)+1
+69 ;S CNTERR(100)=CNTERR(100)+1
End DoDot:1
+70 IF '$TEST
IF $LENGTH(PFZIP)>5!($LENGTH(PFZIP)<5)!'(PFZIP?5N)
Begin DoDot:1
+71 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,11,PFNAME_"_"_PRPFHLD1)="ZIPCODE#^ZIPCODE < or > 5 digits or non-numeric^"_PFZIP
+72 SET CNTERR(11)=CNTERR(11)+1
+73 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+74 SET PFRGNID=""
+75 SET PFICNFLG=$$GETICN^MPIF001(PRPFHLD1)
+76 IF +PFICNFLG'=-1
Begin DoDot:1
+77 IF $DATA(^TMP("PRPF_DIAGX",$JOB,"PFICN",+PFICNFLG))
Begin DoDot:2
+78 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,13,PFNAME_"_"_PRPFHLD1)="ICN^ICN Duplicate^"_PFICNFLG
+79 SET CNTERR(13)=CNTERR(13)+1
+80 SET CNTERR(100)=CNTERR(100)+1
End DoDot:2
+81 SET ^TMP("PRPF_DIAGX",$JOB,"PFICN",+PFICNFLG)=PFICNFLG
End DoDot:1
+82 IF +PFICNFLG=-1
Begin DoDot:1
+83 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,14,PFNAME_"_"_PRPFHLD1)="ICN^ICN Unassigned or invalid^"_$PIECE(PFICNFLG,"^",2)
+84 SET CNTERR(14)=CNTERR(14)+1
+85 SET CNTERR(100)=CNTERR(100)+1
+86 ;S PRPFBJOB=$$MPIQQ^MPIFAPI(PRPFHLD1)
End DoDot:1
+87 SET (PFAUTHRS,PFNAMEX)=""
+88 IF PFAUTH'=""
Begin DoDot:1
+89 SET (PFAUTHRS,PFNAMEX)=$PIECE($GET(^VA(200,PFAUTH,0)),"^",1)
+90 IF $$FORMAT^XLFNAME7(PFNAMEX,3,30)'=PFNAMEX!('$DATA(^VA(200,PFAUTH,0)))
Begin DoDot:2
+91 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,15,PFNAME_"_"_PRPFHLD1)="PFAUTHRS^Provider name contains invalid data^"_PFAUTHRS
+92 SET CNTERR(15)=CNTERR(15)+1
+93 SET CNTERR(100)=CNTERR(100)+1
End DoDot:2
End DoDot:1
+94 SET PFAUTHDT=$PIECE(^PRPF(470,PRPFHLD1,0),"^",12)
+95 IF PFAUTHDT'=""
Begin DoDot:1
+96 KILL PRPFBADD
+97 DO DT^DILF("X",PFAUTHDT,.PRPFBADD)
+98 IF $LENGTH(+PFAUTHDT)'=7!(PRPFBADD=-1)
Begin DoDot:2
+99 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,16,PFNAME_"_"_PRPFHLD1)="PROVAUTHDT^Date of current restriction contains invalid date^"_PFAUTHDT
+100 SET CNTERR(16)=CNTERR(16)+1
+101 SET CNTERR(100)=CNTERR(100)+1
End DoDot:2
End DoDot:1
+102 SET PFSTAT=$PIECE(PFNODE0,"^",2)
+103 IF PFSTAT=""
Begin DoDot:1
+104 SET PRPFBC18=PRPFBC18+1
End DoDot:1
+105 IF PFSTAT'["A"&(PFSTAT'["I")&(PFSTAT'="")
Begin DoDot:1
+106 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,18,PFNAME_"_"_PRPFHLD1)="ACCOUNT STATUS^Account status containing values other than A or I^"_PFSTAT
+107 SET CNTERR(18)=CNTERR(18)+1
+108 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+109 SET PFTYPE=$PIECE(PFNODE0,"^",3)
+110 IF PFTYPE=""
Begin DoDot:1
+111 SET PRPFBC19=PRPFBC19+1
End DoDot:1
+112 IF PFTYPE'["L"&(PFTYPE'["R")&(PFTYPE'["U")&(PFTYPE'["X")&(PFTYPE'="")
Begin DoDot:1
+113 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,19,PFNAME_"_"_PRPFHLD1)="PATIENT TYPE^Patient type values other than L, R, U, X^"_PFTYPE
+114 SET CNTERR(19)=CNTERR(19)+1
+115 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+116 IF (PFAUTH=""&(PFTYPE="L"))!(PFAUTH=""&(PFTYPE="R"))
Begin DoDot:1
+117 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,20,PFNAME_"_"_PRPFHLD1)="PATIENT TYPE/PHY^No Physician name for L or R^"_PFTYPE
+118 SET CNTERR(20)=CNTERR(20)+1
+119 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+120 SET PFPSTAT=$PIECE(PFNODE0,"^",4)
+121 IF PFPSTAT=""
Begin DoDot:1
+122 SET PRPFBC21=PRPFBC21+1
End DoDot:1
+123 IF PFPSTAT'["A"&(PFPSTAT'["R")&(PFPSTAT'["C")&(PFPSTAT'["N")&(PFPSTAT'["X")&(PFPSTAT'="")
Begin DoDot:1
+124 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,21,PFNAME_"_"_PRPFHLD1)="PATIENT STATUS^Patient status values other than A, R, C, N, X^"_PFPSTAT
+125 SET CNTERR(21)=CNTERR(21)+1
+126 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+127 SET PFINDIG=$PIECE(PFNODE0,"^",5)
+128 IF PFINDIG=""
Begin DoDot:1
+129 SET PRPFBC22=PRPFBC22+1
End DoDot:1
+130 IF PFINDIG'["Y"&(PFINDIG'["N")&(PFINDIG'="")
Begin DoDot:1
+131 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,22,PFNAME_"_"_PRPFHLD1)="INDIGENT^Indigent indicator values other than Y, N^"_PFINDIG
+132 SET CNTERR(22)=CNTERR(22)+1
+133 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+134 SET PFAPPOR=$PIECE(PFNODE0,"^",6)
+135 IF PFAPPOR'=""
IF PFAPPOR<0!(PFAPPOR>99999)!((PFAPPOR'=+PFAPPOR)&(PFAPPOR'?.N1".".N))
Begin DoDot:1
+136 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,23,PFNAME_"_"_PRPFHLD1)="APPORTIONEE $^Apportionee amount invalid or out of range either < 0 or > $99,999.00^"_PFAPPOR
+137 SET CNTERR(23)=CNTERR(23)+1
+138 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+139 SET PFGUARD=$PIECE(PFNODE0,"^",7)
+140 IF PFGUARD'=""
IF PFGUARD<0!(PFGUARD>99999)!((PFGUARD'=+PFGUARD)&(PFGUARD'?.N1".".N))
Begin DoDot:1
+141 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,24,PFNAME_"_"_PRPFHLD1)="GUARDIAN $^Guardian amount invalid or out of range either < 0 or > $99,999.00^"_PFGUARD
+142 SET CNTERR(24)=CNTERR(24)+1
+143 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+144 SET PFINSAWD=$PIECE(PFNODE0,"^",8)
+145 IF PFINSAWD'=""
IF PFINSAWD<0!(PFINSAWD>99999)!((PFINSAWD'=+PFINSAWD)&(PFINSAWD'?.N1".".N))
Begin DoDot:1
+146 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,25,PFNAME_"_"_PRPFHLD1)="INSTITUTIONAL AWARD^Institutional award invalid or out of range either < 0 or > $99,999.00^"_PFINSAWD
+147 SET CNTERR(25)=CNTERR(25)+1
+148 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+149 SET PFOTRAST=$PIECE(PFNODE0,"^",10)
+150 IF PFOTRAST'=""
IF PFOTRAST<0!(PFOTRAST>99999)!((PFOTRAST'=+PFOTRAST)&(PFOTRAST'?.N1".".N))
Begin DoDot:1
+151 SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,26,PFNAME_"_"_PRPFHLD1)="OTHER ASSETS^Other assets invalid or out of range either < 0 or > $99,999.00^"_PFOTRAST
+152 SET CNTERR(26)=CNTERR(26)+1
+153 SET CNTERR(100)=CNTERR(100)+1
End DoDot:1
+154 QUIT
NODE0X SET ^TMP("PRPF_DIAGX",$JOB,PFSTAID,17,PFNAME_"_"_PRPFHLD1)="NO DEMO RECORD^No demographic record for account^"_PFNAME
+1 SET CNTERR(17)=CNTERR(17)+1
+2 SET CNTERR(100)=CNTERR(100)+1
+3 QUIT
