- 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 Jan 18, 2025@03:02:48 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