PRPFDR3.m

PRPFDR3 ;BAYPINES/MJE  VPFS DATA MIGRATION ROUTINE 3 ;05/15/03

 ;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989

 ;ENTRY AT LINETAG ONLY

 Q

RPC(RESULTS,PARAM1,PARAM2) ;ENTRY POINT FOR VPFS RPC

 S PRPFJ=PARAM2

 S PRPFSEG=PARAM1

 I PRPFSEG>1 D SENDSEG Q

TESTRPC ;ENTRY POINT FOR TESTING

 K ^TMP("PRPF_DIAGVL")

 D SETUP^PRPFDR2

 S CNTSEG=1

 S CNTTOT=0

 D XSUM

 D XREP

 S RESULTS=$NA(^TMP("PRPF_DIAGVL",$J,1))

 D KILLIT^PRPFDR4

 Q

SENDSEG ;SEND A SEGMENT OF DATA TO MIGRATION JAVA APP

 S RESULTS=$NA(^TMP("PRPF_DIAGVL",PRPFJ,PRPFSEG))

 Q

SEG ;SET UP NEW SEGMENT NODE

 D:PRPFCNTR=10000

 .S CNTSEG=CNTSEG+1

 .S CNTTOT=CNTTOT+PRPFCNTR

 .S PRPFCNTR=0

 Q

XREP S (PFX,PFY,PFZ,PFNAME)=""

 F  S PFX=$O(^TMP("PRPF_DIAGX",$J,PFX)) Q:PFX=""  D

 .F  S PFY=$O(^TMP("PRPF_DIAGX",$J,PFX,PFY)) Q:PFY=""  D

 ..F  S PFZ=$O(^TMP("PRPF_DIAGX",$J,PFX,PFY,PFZ)) Q:PFZ=""  D

 ...S PFTEMP=^TMP("PRPF_DIAGX",$J,PFX,PFY,PFZ)

 ...S PRPFCNTR=PRPFCNTR+1

 ...S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="STATION ID="_PFX_"^ERR#="_PFY_"^NAME="_PFZ_"^DESC="_$P(PFTEMP,"^",2)_"^VALUE=>"_$P(PFTEMP,"^",3)_"<"

 ...D SEG

 S CNTTOT=CNTTOT+PRPFCNTR

 S ^TMP("PRPF_DIAGVL",$J,0)=DTIME_"^"_"DTIME"_"^"_"PRPF MIGRATION DIAGNOSTIC TEMP DATA SENT TO J2EE"

 S ^TMP("PRPF_DIAGVL",$J,1,0)="VPFS"_U_PFSITE_U_U_U_U_"0"_U_"A1"_U_CNTREC_U_CNTTOT_U_$J

 K ^TMP("PRPF_DIAGX")

 Q

XSUM ;THIS ENTRY POINT FOR VISTALINK

 S PRPFCNTR=0

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="**************************************************************************"

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="**      Patient Funds Diagnostic Summary LEGACY RPC    (version 5.9)    **"

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="**************************************************************************"

 D SEG

 D NOW^%DTC S Y=% D DD^%DT

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="Run Date: "_$P(Y,"@",1)_"  Run Time: "_$P(Y,"@",2)_$P("       "," ",1,7-$L(CNTREC))_"                            **"

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="Total accounts processed = "_CNTREC_$P("       "," ",1,7-$L(CNTREC))_"                                       **"

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="Total balance of accounts for migration = $"_$FN(CNTBAL,",",2)_$P("              "," ",1,14-$L($FN(CNTBAL,",",2)))_"                **"

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="**************************************************************************"

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="Err#    Field           Error                                        Total"

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #      Name            Description                                  Count"

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="**************************************************************************"

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #1     NAME            Name is blank                                   "_CNTERR(1)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #2     NAME            Name contains invalid data                      "_CNTERR(2)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #3     SSN             SSN is blank                                    "_CNTERR(3)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #4     SSN             SSN contains invalid data                       "_CNTERR(4)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #5     SSN             SSN contains duplicate value                    "_CNTERR(5)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #6     SSN             SSN contains Pseudo SSN value                   "_CNTRPSU

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #7     DOB             DOB is blank                                    "_CNTERR(7)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #8     DOB             DOB contains invalid date                       "_CNTERR(8)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #9     WARD            Ward loc invalid length                         "_CNTERR(9)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #10    CLAIM           Claim # contains invalid data                   "_CNTERR(10)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #11    ZIP             Zipcode contains invalid data                   "_CNTERR(11)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #12    REGION OFFICE   Regional Office ID invalid data                 "_CNTERR(12)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #13    ICN             ICN Duplicate                                   "_CNTERR(13)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #14    ICN             ICN unassigned or invalid                       "_CNTERR(14)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #15    PROVIDER AUTHR  Provider Name contains invalid data             "_CNTERR(15)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#16    PROVID AUTH DT  Date of current restriction invalid date        "_CNTERR(16)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#17    NO DEMO REC     No demographic record for account               "_CNTERR(17)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#18    ACCOUNT STATUS  Account status not (A),I,Blank="_PRPFBC18_$P("      "," ",1,6-$L(PRPFBC18))_"            "_CNTERR(18)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#19    PATIENT TYPE    Patient type not L,R,(U),X,Blank="_PRPFBC19_$P("      "," ",1,8-$L(PRPFBC19))_"        "_CNTERR(19)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#20    PAT TYPE/PHY    Patient type L or R without Phy name            "_CNTERR(20)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#21    PATIENT STATUS  Patient Status not A,R,C,N,(X),Blank="_PRPFBC21_$P("      "," ",1,6-$L(PRPFBC21))_"      "_CNTERR(21)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#22    INDIGENT        Indigent status not (N),Y,Blank="_PRPFBC22_$P("      "," ",1,6-$L(PRPFBC22))_"           "_CNTERR(22)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#23    APPORTIONEE $   Apportionee amount invalid or < $0 or > $99,999 "_CNTERR(23)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#24    GUARDIAN $      Guardian amount invalid or < $0 or > $99,999    "_CNTERR(24)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#25    INSTITUT AWARD  Institut award invalid or < $0 or > $99,999     "_CNTERR(25)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#26    OTHER ASSETS    Other assets invalid or < $0 or > $99,999       "_CNTERR(26)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#27    STORED BALANCE  Stored balance invalid or < $0 or > $99,999     "_CNTERR(27)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#28    STORED PRIVATE  Stored private invalid or < $0 or > $99,999     "_CNTERR(28)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#29    STORED GRATUIT  Stored gratuitous invalid or < $0 or > $99,999  "_CNTERR(29)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#30    RESTRCT MONTH   Restricted Monthly invalid or < $0 or > $99,999 "_CNTERR(30)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#31    RESTRCT WEEKLY  Restricted Weekly invalid or < $0 or > $99,999  "_CNTERR(31)

 D SEG

 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#32    RESTRCT AMT ER  Restrict Mnthly amount > (5X) weekly amt        "_CNTERR(32)

 D SEG

 D XSUM1^PRPFDR6

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRPFDR3   8339     printed  Apr 09, 2024@21:04:27                                                                                                                                                                                                     Page 2

PRPFDR3   ;BAYPINES/MJE  VPFS DATA MIGRATION ROUTINE 3 ;05/15/03

 +1       ;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989

 +2       ;ENTRY AT LINETAG ONLY

 +3        QUIT 

RPC(RESULTS,PARAM1,PARAM2) ;ENTRY POINT FOR VPFS RPC

 +1        SET PRPFJ=PARAM2

 +2        SET PRPFSEG=PARAM1

 +3        IF PRPFSEG>1

               DO SENDSEG

               QUIT 

TESTRPC   ;ENTRY POINT FOR TESTING

 +1        KILL ^TMP("PRPF_DIAGVL")

 +2        DO SETUP^PRPFDR2

 +3        SET CNTSEG=1

 +4        SET CNTTOT=0

 +5        DO XSUM

 +6        DO XREP

 +7        SET RESULTS=$NAME(^TMP("PRPF_DIAGVL",$JOB,1))

 +8        DO KILLIT^PRPFDR4

 +9        QUIT 

SENDSEG   ;SEND A SEGMENT OF DATA TO MIGRATION JAVA APP

 +1        SET RESULTS=$NAME(^TMP("PRPF_DIAGVL",PRPFJ,PRPFSEG))

 +2        QUIT 

SEG       ;SET UP NEW SEGMENT NODE

 +1        if PRPFCNTR=10000

               Begin DoDot:1

 +2                SET CNTSEG=CNTSEG+1

 +3                SET CNTTOT=CNTTOT+PRPFCNTR

 +4                SET PRPFCNTR=0

               End DoDot:1

 +5        QUIT 

XREP       SET (PFX,PFY,PFZ,PFNAME)=""

 +1        FOR 

               SET PFX=$ORDER(^TMP("PRPF_DIAGX",$JOB,PFX))

               if PFX=""

                   QUIT 

               Begin DoDot:1

 +2                FOR 

                       SET PFY=$ORDER(^TMP("PRPF_DIAGX",$JOB,PFX,PFY))

                       if PFY=""

                           QUIT 

                       Begin DoDot:2

 +3                        FOR 

                               SET PFZ=$ORDER(^TMP("PRPF_DIAGX",$JOB,PFX,PFY,PFZ))

                               if PFZ=""

                                   QUIT 

                               Begin DoDot:3

 +4                                SET PFTEMP=^TMP("PRPF_DIAGX",$JOB,PFX,PFY,PFZ)

 +5                                SET PRPFCNTR=PRPFCNTR+1

 +6                                SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="STATION ID="_PFX_"^ERR#="_PFY_"^NAME="_PFZ_"^DESC="_$PIECE(PFTEMP,"^",2)_"^VALUE=>"_$PIECE(PFTEMP,"^",3)_"<"

 +7                                DO SEG

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +8        SET CNTTOT=CNTTOT+PRPFCNTR

 +9        SET ^TMP("PRPF_DIAGVL",$JOB,0)=DTIME_"^"_"DTIME"_"^"_"PRPF MIGRATION DIAGNOSTIC TEMP DATA SENT TO J2EE"

 +10       SET ^TMP("PRPF_DIAGVL",$JOB,1,0)="VPFS"_U_PFSITE_U_U_U_U_"0"_U_"A1"_U_CNTREC_U_CNTTOT_U_$JOB

 +11       KILL ^TMP("PRPF_DIAGX")

 +12       QUIT 

XSUM      ;THIS ENTRY POINT FOR VISTALINK

 +1        SET PRPFCNTR=0

 +2        SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="**************************************************************************"

 +3        DO SEG

 +4        SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="**      Patient Funds Diagnostic Summary LEGACY RPC    (version 5.9)    **"

 +5        DO SEG

 +6        SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="**************************************************************************"

 +7        DO SEG

 +8        DO NOW^%DTC

           SET Y=%

           DO DD^%DT

 +9        SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="Run Date: "_$PIECE(Y,"@",1)_"  Run Time: "_$PIECE(Y,"@",2)_$PIECE("       "," ",1,7-$LENGTH(CNTREC))_"                            **"

 +10       DO SEG

 +11       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="Total accounts processed = "_CNTREC_$PIECE("       "," ",1,7-$LENGTH(CNTREC))_"                                       **"

 +12       DO SEG

 +13       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="Total balance of accounts for migration = $"_$FNUMBER(CNTBAL,",",2)_$PIECE("              "," ",1,14-$LENGTH($FNUMBER(CNTBAL,",",2)))_"                **"

 +14       DO SEG

 +15       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="**************************************************************************"

 +16       DO SEG

 +17       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="Err#    Field           Error                                        Total"

 +18       DO SEG

 +19       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #      Name            Description                                  Count"

 +20       DO SEG

 +21       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="**************************************************************************"

 +22       DO SEG

 +23       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #1     NAME            Name is blank                                   "_CNTERR(1)

 +24       DO SEG

 +25       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #2     NAME            Name contains invalid data                      "_CNTERR(2)

 +26       DO SEG

 +27       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #3     SSN             SSN is blank                                    "_CNTERR(3)

 +28       DO SEG

 +29       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #4     SSN             SSN contains invalid data                       "_CNTERR(4)

 +30       DO SEG

 +31       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #5     SSN             SSN contains duplicate value                    "_CNTERR(5)

 +32       DO SEG

 +33       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #6     SSN             SSN contains Pseudo SSN value                   "_CNTRPSU

 +34       DO SEG

 +35       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #7     DOB             DOB is blank                                    "_CNTERR(7)

 +36       DO SEG

 +37       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #8     DOB             DOB contains invalid date                       "_CNTERR(8)

 +38       DO SEG

 +39       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #9     WARD            Ward loc invalid length                         "_CNTERR(9)

 +40       DO SEG

 +41       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #10    CLAIM           Claim # contains invalid data                   "_CNTERR(10)

 +42       DO SEG

 +43       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #11    ZIP             Zipcode contains invalid data                   "_CNTERR(11)

 +44       DO SEG

 +45       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #12    REGION OFFICE   Regional Office ID invalid data                 "_CNTERR(12)

 +46       DO SEG

 +47       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #13    ICN             ICN Duplicate                                   "_CNTERR(13)

 +48       DO SEG

 +49       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #14    ICN             ICN unassigned or invalid                       "_CNTERR(14)

 +50       DO SEG

 +51       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)=" #15    PROVIDER AUTHR  Provider Name contains invalid data             "_CNTERR(15)

 +52       DO SEG

 +53       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#16    PROVID AUTH DT  Date of current restriction invalid date        "_CNTERR(16)

 +54       DO SEG

 +55       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#17    NO DEMO REC     No demographic record for account               "_CNTERR(17)

 +56       DO SEG

 +57       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#18    ACCOUNT STATUS  Account status not (A),I,Blank="_PRPFBC18_$PIECE("      "," ",1,6-$LENGTH(PRPFBC18))_"            "_CNTERR(18)

 +58       DO SEG

 +59       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#19    PATIENT TYPE    Patient type not L,R,(U),X,Blank="_PRPFBC19_$PIECE("      "," ",1,8-$LENGTH(PRPFBC19))_"        "_CNTERR(19)

 +60       DO SEG

 +61       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#20    PAT TYPE/PHY    Patient type L or R without Phy name            "_CNTERR(20)

 +62       DO SEG

 +63       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#21    PATIENT STATUS  Patient Status not A,R,C,N,(X),Blank="_PRPFBC21_$PIECE("      "," ",1,6-$LENGTH(PRPFBC21))_"      "_CNTERR(21)

 +64       DO SEG

 +65       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#22    INDIGENT        Indigent status not (N),Y,Blank="_PRPFBC22_$PIECE("      "," ",1,6-$LENGTH(PRPFBC22))_"           "_CNTERR(22)

 +66       DO SEG

 +67       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#23    APPORTIONEE $   Apportionee amount invalid or < $0 or > $99,999 "_CNTERR(23)

 +68       DO SEG

 +69       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#24    GUARDIAN $      Guardian amount invalid or < $0 or > $99,999    "_CNTERR(24)

 +70       DO SEG

 +71       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#25    INSTITUT AWARD  Institut award invalid or < $0 or > $99,999     "_CNTERR(25)

 +72       DO SEG

 +73       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#26    OTHER ASSETS    Other assets invalid or < $0 or > $99,999       "_CNTERR(26)

 +74       DO SEG

 +75       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#27    STORED BALANCE  Stored balance invalid or < $0 or > $99,999     "_CNTERR(27)

 +76       DO SEG

 +77       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#28    STORED PRIVATE  Stored private invalid or < $0 or > $99,999     "_CNTERR(28)

 +78       DO SEG

 +79       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#29    STORED GRATUIT  Stored gratuitous invalid or < $0 or > $99,999  "_CNTERR(29)

 +80       DO SEG

 +81       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#30    RESTRCT MONTH   Restricted Monthly invalid or < $0 or > $99,999 "_CNTERR(30)

 +82       DO SEG

 +83       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#31    RESTRCT WEEKLY  Restricted Weekly invalid or < $0 or > $99,999  "_CNTERR(31)

 +84       DO SEG

 +85       SET PRPFCNTR=PRPFCNTR+1

           SET ^TMP("PRPF_DIAGVL",$JOB,CNTSEG,PRPFCNTR)="*#32    RESTRCT AMT ER  Restrict Mnthly amount > (5X) weekly amt        "_CNTERR(32)

 +86       DO SEG

 +87       DO XSUM1^PRPFDR6

 +88       QUIT