- PRPFDR2 ;BAYPINES/MJE VPFS DATA MIGRATION ROUTINE 2 ;05/15/03
- ;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989
- ;ENTRY AT LINETAG ONLY
- Q
- LEG ;ENTRY POINT FOR LEGACY SYSTEM
- D SETUP
- D SUM
- W !
- W !,"NOTE: In addition to the summary report there is an available detail"
- W !,"report, this report can be sent to any device or flat file if required."
- W !,""
- W !,">>>>> The detail diagnostic report will contain "_CNTERR(100)_" lines."
- W !,""
- W !,"If you still desire the detail report, then please input the name of the"
- W !,"device that the report will be sent to."
- W !,""
- W !,"If the detail report is not desired then input ""^"" at the device prompt and the detail report will not print."
- W !,""
- D REP
- K ^TMP("PRPF_DIAGX")
- D KILLIT^PRPFDR4
- Q
- REP S (PFX,PFY,PFZ,PFNAME)=""
- S %ZIS("B")="",%ZIS("HFSMODE")="W" D ^%ZIS K XION R X:2
- I POP K ^TMP("PRPF_DIAGX") Q
- U IO
- D SUM
- 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)
- ...W !,"STATION ID="_PFX_"^ERR#="_PFY_"^NAME="_PFZ_"^DESC="_$P(PFTEMP,"^",2)_"^VALUE=>"_$P(PFTEMP,"^",3)_"<"
- D ^%ZISC
- Q
- SUM W !,"**************************************************************************"
- W !,"** Patient Funds Diagnostic Summary (version 5.9) **"
- W !,"**************************************************************************"
- D NOW^%DTC S Y=% D DD^%DT
- W !,"Run Date: "_$P(Y,"@",1)_" Run Time: "_$P(Y,"@",2),?72,"**"
- W !,"Total accounts processed = "_CNTREC,?72,"**"
- W !,"Total balance of accounts for migration = $"_$FN(CNTBAL,",",2),?72,"**"
- W !,"**************************************************************************"
- W !,"Err# Field Error Total"
- W !," # Name Description Count"
- W !,"**************************************************************************"
- W !," #1 NAME Name is blank",?72,CNTERR(1)
- W !," #2 NAME Name contains invalid data",?72,CNTERR(2)
- W !," #3 SSN SSN is blank",?72,CNTERR(3)
- W !," #4 SSN SSN contains invalid data",?72,CNTERR(4)
- W !," #5 SSN SSN contains duplicate value",?72,CNTERR(5)
- W !," #6 SSN SSN contains Pseudo SSN value",?72,CNTRPSU
- W !," #7 DOB DOB is blank",?72,CNTERR(7)
- W !," #8 DOB DOB contains invalid date",?72,CNTERR(8)
- W !," #9 WARD Ward loc invalid length",?72,CNTERR(9)
- W !," #10 CLAIM Claim # contains invalid data",?72,CNTERR(10)
- W !," #11 ZIP Zipcode contains invalid data",?72,CNTERR(11)
- W !," #12 REGION OFFICE Regional Office ID invalid data",?72,CNTERR(12)
- W !," #13 ICN ICN Duplicate",?72,CNTERR(13)
- W !," #14 ICN ICN unassigned or invalid",?72,CNTERR(14)
- W !," #15 PROVIDER AUTHR Provider Name contains invalid data",?72,CNTERR(15)
- W !,"*#16 PROVID AUTH DT Date of current restriction invalid date",?72,CNTERR(16)
- W !,"*#17 NO DEMO RECORD No demographic record for account",?72,CNTERR(17)
- W !,"*#18 ACCOUNT STATUS Account status not (A),I,Blank="_PRPFBC18,?72,CNTERR(18)
- W !,"*#19 PATIENT TYPE Patient type not L,R,(U),X,Blank="_PRPFBC19,?72,CNTERR(19)
- W !,"*#20 PAT TYPE/PHY Patient type L or R without Phy name",?72,CNTERR(20)
- W !,"*#21 PATIENT STATUS Patient Status not A,R,C,N,(X),Blank="_PRPFBC21,?72,CNTERR(21)
- W !,"*#22 INDIGENT Indigent status not (N),Y,Blank="_PRPFBC22,?72,CNTERR(22)
- W !,"*#23 APPORTIONEE $ Apportionee amount invalid or < $0 or > $99,999",?72,CNTERR(23)
- W !,"*#24 GUARDIAN $ Guardian amount invalid or < $0 or > $99,999",?72,CNTERR(24)
- W !,"*#25 INSTITUT AWARD Institut award invalid or < $0 or > $99,999",?72,CNTERR(25)
- W !,"*#26 OTHER ASSETS Other assets invalid or < $0 or > $99,999",?72,CNTERR(26)
- W !,"*#27 STORED BALANCE Stored balance invalid or < $0 or > $99,999",?72,CNTERR(27)
- W !,"*#28 STORED PRIVATE Stored private invalid or < $0 or > $99,999",?72,CNTERR(28)
- W !,"*#29 STORED GRATUIT Stored gratuitous invalid or < $0 or > $99,999",?72,CNTERR(29)
- W !,"*#30 RESTRCT MONTH Restricted Monthly invalid or < $0 or > $99,999",?72,CNTERR(30)
- W !,"*#31 RESTRCT WEEKLY Restricted Weekly invalid or < $0 or > $99,999",?72,CNTERR(31)
- W !,"*#32 RESTRCT AMT ER Restrict Mnthly amount < (5X) weekly amt",?72,CNTERR(32)
- W !,"*#33 RESTRCT AMT ER Restrict Mnthly amount < weekly amt",?72,CNTERR(33)
- W !,"*#34 MINIMUM BAL Minimum balance #1 invalid or < $0 or > $99,999",?72,CNTERR(34)
- W !,"*#35 MAXIMUM BAL Maximum balance #1 invalid or < $0 or > $99,999",?72,CNTERR(35)
- W !,"*#36 NO BALANCE REC Balance record missing for account",?72,CNTERR(36)
- W !,"*#37 INCOME PAYEE Income payee blank, Income source present",?72,CNTERR(37)
- W !,"*#38 INCOME AMOUNT Income amount error, Income source present",?72,CNTERR(38)
- W !,"*#39 INCOME AMOUNT Income amount < $1 or > $99,999",?72,CNTERR(39)
- W !,"*#40 INCOME FREQCY Income frequency not D,W,M,Y,X,V,O,Blank="_PRPFBC40,?72,CNTERR(40)
- W !,"*#41 STATION ID Station ID blank or unassigned",?72,CNTERR(41)
- W !," #42 STATION ID Station ID invalid",?72,CNTERR(42)
- W !,"*#43 SUSPENSE DATE Suspense date has invalid date",?72,CNTERR(43)
- W !,"*#44 SUSPENSE ID Suspense ID has Invalid data",?72,CNTERR(44)
- W !,"*#45 SUSPENSE TEXT Suspense text is < 1 or > 255 characters",?72,CNTERR(45)
- W !,"*#46 DEFERRED TRANS There are "_PRPFDEFR_" deferred transactions",?72,PRPFDEFR
- W !,"*#47 TRANSACTION REC Transaction record missing, blank or ID invalid",?72,CNTERR(47)
- W !,"*#48 PATIENT NAME Patient name does not match deferred trans",?72,CNTERR(48)
- W !,"*#49 PATIENT TRANS # Patient transaction # invalid",?72,CNTERR(49)
- W !,"*#50 DEFR AMOUNT Deferred amount invalid",?72,CNTERR(50)
- W !,"*#51 TRANSACTN DATE Transaction date Invalid",?72,CNTERR(51)
- W !,"*#52 DT TRAN ENTD Date transaction entered Invalid",?72,CNTERR(52)
- W !,"*#53 REFERENCE Reference Invalid < 1 or > 10 in length",?72,CNTERR(53)
- W !,"*#54 DEPOSIT/WTHDRWL Deposit/Withdrawal status Invalid",?72,CNTERR(54)
- W !,"*#55 CASH/CHECK/OTR Cash/Check/Other status Invalid",?72,CNTERR(55)
- W !,"*#56 SOURCE Transaction source invalid",?72,CNTERR(56)
- W !,"*#57 FORM Form does not match",?72,CNTERR(57)
- W !,"*#58 PRVT SOURCE AMT Private source amount invalid or < 0 or > 99999",?72,CNTERR(58)
- W !,"*#59 GRATUITOUS AMT Gratuitous amount invalid or < 0 or > 99999",?72,CNTERR(59)
- W !,"*#60 PFUNDS CLERK PFunds clerk invalid",?72,CNTERR(60)
- W !,"**************************************************************************"
- Q
- SETUP ;SETUP PARAMS GET DATA
- K ^TMP("PRPF_DIAGX")
- S ^TMP("PRPF_DIAGX",$J,0)=DTIME_"^"_"DTIME"_"^"_"PRPF MIGRATION DIAGNOSTIC TEMP DATA"
- S (PRPFDEFR,PRPFBBAL,PRPFBDMO,PRPFHLD1,PRPFHLD2,PRPFHLD3,PRPFHLD4,CNTBAL,CNTREC,CNTRPSU,PFG,PFSTDBAL)=0
- S (PRPFBC18,PRPFBC19,PRPFBC21,PRPFBC22,PRPFBC40)=0
- F I=1:1:100 D
- .S CNTERR(I)=0
- F S PRPFHLD1=$O(^PRPF(470,PRPFHLD1)) Q:'PRPFHLD1 D
- .S PFG=PFG+1 I PFG=100 W "." S PFG=0
- .S ND=""
- .S CNTREC=CNTREC+1
- .D:$G(^PRPF(470,PRPFHLD1,0))'="" COMPU
- .I $D(^PRPF(470,PRPFHLD1,12)) I $G(^PRPF(470,PRPFHLD1,12))'="" D
- ..I $D(^DIC(4,^PRPF(470,PRPFHLD1,12),99)) I $P(^DIC(4,^PRPF(470,PRPFHLD1,12),99),"^",1)'="" D
- ...S PFSTAID=^PRPF(470,PRPFHLD1,12)
- ...D NODE12^PRPFDR1
- ..I $D(^DIC(4,^PRPF(470,PRPFHLD1,12),99)) I $P(^DIC(4,^PRPF(470,PRPFHLD1,12),99),"^",1)="" D
- ...S PFSTAID="ERRBADID1"
- ...D NODE12^PRPFDR1
- ..I '$D(^DIC(4,^PRPF(470,PRPFHLD1,12),99)) D
- ...S PFSTAID="ERRBADID"
- ...D NODE12^PRPFDR1
- .I '$D(^PRPF(470,PRPFHLD1,12)) S PFSTAID="ERRNOID" D NODE12X^PRPFDR1
- .I $D(^PRPF(470,PRPFHLD1,12)) I $G(^PRPF(470,PRPFHLD1,12))="" D
- ..S PFSTAID="ERRNOID1"
- ..D NODE12X^PRPFDR1
- .D:$G(^PRPF(470,PRPFHLD1,0))'="" NODE0^PRPFDR5
- .D:$G(^PRPF(470,PRPFHLD1,0))="" NODE0X^PRPFDR5
- .D:$G(^PRPF(470,PRPFHLD1,1))'="" NODE1^PRPFDR4
- .D:$G(^PRPF(470,PRPFHLD1,1))="" NODE1X^PRPFDR4
- .D:$G(^PRPF(470,PRPFHLD1,2))'="" NODE2^PRPFDR4
- .D:$O(^PRPF(470,PRPFHLD1,4,0))>0 NODE4^PRPFDR1
- .D:$O(^PRPF(470,PRPFHLD1,5,0))>0 NODE5^PRPFDR1
- .D:$O(^PRPF(470,PRPFHLD1,6,0))>0 NODE6^PRPFDR4
- Q
- ;***************************************************************
- COMPU ; SPECIFIC PATIENT INFO LOOKUP
- S PFNAME=$P($G(^DPT(PRPFHLD1,0)),"^",1)
- S PFSSN=$P($G(^DPT(PRPFHLD1,0)),"^",9)
- I PFNAME="" I PFSSN'="" S PFNAME="NAME-MISSING-SSN#"_PFSSN
- I PFNAME="" I PFSSN="" S PFNAME="NAME-MISSING-NO-SSN-IEN#"_PRPFHLD1
- S PFDOB=$P($G(^DPT(PRPFHLD1,0)),"^",3)
- S PFWARD=$P($G(^DPT(PRPFHLD1,.1)),"^",1)
- S PFCLAIM=$P($G(^DPT(PRPFHLD1,.31)),"^",3)
- S PFADDR1=$P($G(^DPT(PRPFHLD1,.11)),"^",1)
- S PFADDR2=$P($G(^DPT(PRPFHLD1,.11)),"^",2)
- S PFADDR3=$P($G(^DPT(PRPFHLD1,.11)),"^",3)
- S PFCITY=$P($G(^DPT(PRPFHLD1,.11)),"^",4)
- S PFSTATE=$P($G(^DPT(PRPFHLD1,.11)),"^",5)
- S PFZIP=$P($G(^DPT(PRPFHLD1,.11)),"^",6)
- S PFSITE=$P($$SITE^VASITE(),"^",3)
- S:PFSITE="" PFSITE="###"
- S PFAUTH=$P(^PRPF(470,PRPFHLD1,0),"^",13)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRPFDR2 9441 printed Feb 18, 2025@23:27:55 Page 2
- PRPFDR2 ;BAYPINES/MJE VPFS DATA MIGRATION ROUTINE 2 ;05/15/03
- +1 ;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989
- +2 ;ENTRY AT LINETAG ONLY
- +3 QUIT
- LEG ;ENTRY POINT FOR LEGACY SYSTEM
- +1 DO SETUP
- +2 DO SUM
- +3 WRITE !
- +4 WRITE !,"NOTE: In addition to the summary report there is an available detail"
- +5 WRITE !,"report, this report can be sent to any device or flat file if required."
- +6 WRITE !,""
- +7 WRITE !,">>>>> The detail diagnostic report will contain "_CNTERR(100)_" lines."
- +8 WRITE !,""
- +9 WRITE !,"If you still desire the detail report, then please input the name of the"
- +10 WRITE !,"device that the report will be sent to."
- +11 WRITE !,""
- +12 WRITE !,"If the detail report is not desired then input ""^"" at the device prompt and the detail report will not print."
- +13 WRITE !,""
- +14 DO REP
- +15 KILL ^TMP("PRPF_DIAGX")
- +16 DO KILLIT^PRPFDR4
- +17 QUIT
- REP SET (PFX,PFY,PFZ,PFNAME)=""
- +1 SET %ZIS("B")=""
- SET %ZIS("HFSMODE")="W"
- DO ^%ZIS
- KILL XION
- READ X:2
- +2 IF POP
- KILL ^TMP("PRPF_DIAGX")
- QUIT
- +3 USE IO
- +4 DO SUM
- +5 FOR
- SET PFX=$ORDER(^TMP("PRPF_DIAGX",$JOB,PFX))
- if PFX=""
- QUIT
- Begin DoDot:1
- +6 FOR
- SET PFY=$ORDER(^TMP("PRPF_DIAGX",$JOB,PFX,PFY))
- if PFY=""
- QUIT
- Begin DoDot:2
- +7 FOR
- SET PFZ=$ORDER(^TMP("PRPF_DIAGX",$JOB,PFX,PFY,PFZ))
- if PFZ=""
- QUIT
- Begin DoDot:3
- +8 SET PFTEMP=^TMP("PRPF_DIAGX",$JOB,PFX,PFY,PFZ)
- +9 WRITE !,"STATION ID="_PFX_"^ERR#="_PFY_"^NAME="_PFZ_"^DESC="_$PIECE(PFTEMP,"^",2)_"^VALUE=>"_$PIECE(PFTEMP,"^",3)_"<"
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 DO ^%ZISC
- +11 QUIT
- SUM WRITE !,"**************************************************************************"
- +1 WRITE !,"** Patient Funds Diagnostic Summary (version 5.9) **"
- +2 WRITE !,"**************************************************************************"
- +3 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- +4 WRITE !,"Run Date: "_$PIECE(Y,"@",1)_" Run Time: "_$PIECE(Y,"@",2),?72,"**"
- +5 WRITE !,"Total accounts processed = "_CNTREC,?72,"**"
- +6 WRITE !,"Total balance of accounts for migration = $"_$FNUMBER(CNTBAL,",",2),?72,"**"
- +7 WRITE !,"**************************************************************************"
- +8 WRITE !,"Err# Field Error Total"
- +9 WRITE !," # Name Description Count"
- +10 WRITE !,"**************************************************************************"
- +11 WRITE !," #1 NAME Name is blank",?72,CNTERR(1)
- +12 WRITE !," #2 NAME Name contains invalid data",?72,CNTERR(2)
- +13 WRITE !," #3 SSN SSN is blank",?72,CNTERR(3)
- +14 WRITE !," #4 SSN SSN contains invalid data",?72,CNTERR(4)
- +15 WRITE !," #5 SSN SSN contains duplicate value",?72,CNTERR(5)
- +16 WRITE !," #6 SSN SSN contains Pseudo SSN value",?72,CNTRPSU
- +17 WRITE !," #7 DOB DOB is blank",?72,CNTERR(7)
- +18 WRITE !," #8 DOB DOB contains invalid date",?72,CNTERR(8)
- +19 WRITE !," #9 WARD Ward loc invalid length",?72,CNTERR(9)
- +20 WRITE !," #10 CLAIM Claim # contains invalid data",?72,CNTERR(10)
- +21 WRITE !," #11 ZIP Zipcode contains invalid data",?72,CNTERR(11)
- +22 WRITE !," #12 REGION OFFICE Regional Office ID invalid data",?72,CNTERR(12)
- +23 WRITE !," #13 ICN ICN Duplicate",?72,CNTERR(13)
- +24 WRITE !," #14 ICN ICN unassigned or invalid",?72,CNTERR(14)
- +25 WRITE !," #15 PROVIDER AUTHR Provider Name contains invalid data",?72,CNTERR(15)
- +26 WRITE !,"*#16 PROVID AUTH DT Date of current restriction invalid date",?72,CNTERR(16)
- +27 WRITE !,"*#17 NO DEMO RECORD No demographic record for account",?72,CNTERR(17)
- +28 WRITE !,"*#18 ACCOUNT STATUS Account status not (A),I,Blank="_PRPFBC18,?72,CNTERR(18)
- +29 WRITE !,"*#19 PATIENT TYPE Patient type not L,R,(U),X,Blank="_PRPFBC19,?72,CNTERR(19)
- +30 WRITE !,"*#20 PAT TYPE/PHY Patient type L or R without Phy name",?72,CNTERR(20)
- +31 WRITE !,"*#21 PATIENT STATUS Patient Status not A,R,C,N,(X),Blank="_PRPFBC21,?72,CNTERR(21)
- +32 WRITE !,"*#22 INDIGENT Indigent status not (N),Y,Blank="_PRPFBC22,?72,CNTERR(22)
- +33 WRITE !,"*#23 APPORTIONEE $ Apportionee amount invalid or < $0 or > $99,999",?72,CNTERR(23)
- +34 WRITE !,"*#24 GUARDIAN $ Guardian amount invalid or < $0 or > $99,999",?72,CNTERR(24)
- +35 WRITE !,"*#25 INSTITUT AWARD Institut award invalid or < $0 or > $99,999",?72,CNTERR(25)
- +36 WRITE !,"*#26 OTHER ASSETS Other assets invalid or < $0 or > $99,999",?72,CNTERR(26)
- +37 WRITE !,"*#27 STORED BALANCE Stored balance invalid or < $0 or > $99,999",?72,CNTERR(27)
- +38 WRITE !,"*#28 STORED PRIVATE Stored private invalid or < $0 or > $99,999",?72,CNTERR(28)
- +39 WRITE !,"*#29 STORED GRATUIT Stored gratuitous invalid or < $0 or > $99,999",?72,CNTERR(29)
- +40 WRITE !,"*#30 RESTRCT MONTH Restricted Monthly invalid or < $0 or > $99,999",?72,CNTERR(30)
- +41 WRITE !,"*#31 RESTRCT WEEKLY Restricted Weekly invalid or < $0 or > $99,999",?72,CNTERR(31)
- +42 WRITE !,"*#32 RESTRCT AMT ER Restrict Mnthly amount < (5X) weekly amt",?72,CNTERR(32)
- +43 WRITE !,"*#33 RESTRCT AMT ER Restrict Mnthly amount < weekly amt",?72,CNTERR(33)
- +44 WRITE !,"*#34 MINIMUM BAL Minimum balance #1 invalid or < $0 or > $99,999",?72,CNTERR(34)
- +45 WRITE !,"*#35 MAXIMUM BAL Maximum balance #1 invalid or < $0 or > $99,999",?72,CNTERR(35)
- +46 WRITE !,"*#36 NO BALANCE REC Balance record missing for account",?72,CNTERR(36)
- +47 WRITE !,"*#37 INCOME PAYEE Income payee blank, Income source present",?72,CNTERR(37)
- +48 WRITE !,"*#38 INCOME AMOUNT Income amount error, Income source present",?72,CNTERR(38)
- +49 WRITE !,"*#39 INCOME AMOUNT Income amount < $1 or > $99,999",?72,CNTERR(39)
- +50 WRITE !,"*#40 INCOME FREQCY Income frequency not D,W,M,Y,X,V,O,Blank="_PRPFBC40,?72,CNTERR(40)
- +51 WRITE !,"*#41 STATION ID Station ID blank or unassigned",?72,CNTERR(41)
- +52 WRITE !," #42 STATION ID Station ID invalid",?72,CNTERR(42)
- +53 WRITE !,"*#43 SUSPENSE DATE Suspense date has invalid date",?72,CNTERR(43)
- +54 WRITE !,"*#44 SUSPENSE ID Suspense ID has Invalid data",?72,CNTERR(44)
- +55 WRITE !,"*#45 SUSPENSE TEXT Suspense text is < 1 or > 255 characters",?72,CNTERR(45)
- +56 WRITE !,"*#46 DEFERRED TRANS There are "_PRPFDEFR_" deferred transactions",?72,PRPFDEFR
- +57 WRITE !,"*#47 TRANSACTION REC Transaction record missing, blank or ID invalid",?72,CNTERR(47)
- +58 WRITE !,"*#48 PATIENT NAME Patient name does not match deferred trans",?72,CNTERR(48)
- +59 WRITE !,"*#49 PATIENT TRANS # Patient transaction # invalid",?72,CNTERR(49)
- +60 WRITE !,"*#50 DEFR AMOUNT Deferred amount invalid",?72,CNTERR(50)
- +61 WRITE !,"*#51 TRANSACTN DATE Transaction date Invalid",?72,CNTERR(51)
- +62 WRITE !,"*#52 DT TRAN ENTD Date transaction entered Invalid",?72,CNTERR(52)
- +63 WRITE !,"*#53 REFERENCE Reference Invalid < 1 or > 10 in length",?72,CNTERR(53)
- +64 WRITE !,"*#54 DEPOSIT/WTHDRWL Deposit/Withdrawal status Invalid",?72,CNTERR(54)
- +65 WRITE !,"*#55 CASH/CHECK/OTR Cash/Check/Other status Invalid",?72,CNTERR(55)
- +66 WRITE !,"*#56 SOURCE Transaction source invalid",?72,CNTERR(56)
- +67 WRITE !,"*#57 FORM Form does not match",?72,CNTERR(57)
- +68 WRITE !,"*#58 PRVT SOURCE AMT Private source amount invalid or < 0 or > 99999",?72,CNTERR(58)
- +69 WRITE !,"*#59 GRATUITOUS AMT Gratuitous amount invalid or < 0 or > 99999",?72,CNTERR(59)
- +70 WRITE !,"*#60 PFUNDS CLERK PFunds clerk invalid",?72,CNTERR(60)
- +71 WRITE !,"**************************************************************************"
- +72 QUIT
- SETUP ;SETUP PARAMS GET DATA
- +1 KILL ^TMP("PRPF_DIAGX")
- +2 SET ^TMP("PRPF_DIAGX",$JOB,0)=DTIME_"^"_"DTIME"_"^"_"PRPF MIGRATION DIAGNOSTIC TEMP DATA"
- +3 SET (PRPFDEFR,PRPFBBAL,PRPFBDMO,PRPFHLD1,PRPFHLD2,PRPFHLD3,PRPFHLD4,CNTBAL,CNTREC,CNTRPSU,PFG,PFSTDBAL)=0
- +4 SET (PRPFBC18,PRPFBC19,PRPFBC21,PRPFBC22,PRPFBC40)=0
- +5 FOR I=1:1:100
- Begin DoDot:1
- +6 SET CNTERR(I)=0
- End DoDot:1
- +7 FOR
- SET PRPFHLD1=$ORDER(^PRPF(470,PRPFHLD1))
- if 'PRPFHLD1
- QUIT
- Begin DoDot:1
- +8 SET PFG=PFG+1
- IF PFG=100
- WRITE "."
- SET PFG=0
- +9 SET ND=""
- +10 SET CNTREC=CNTREC+1
- +11 if $GET(^PRPF(470,PRPFHLD1,0))'=""
- DO COMPU
- +12 IF $DATA(^PRPF(470,PRPFHLD1,12))
- IF $GET(^PRPF(470,PRPFHLD1,12))'=""
- Begin DoDot:2
- +13 IF $DATA(^DIC(4,^PRPF(470,PRPFHLD1,12),99))
- IF $PIECE(^DIC(4,^PRPF(470,PRPFHLD1,12),99),"^",1)'=""
- Begin DoDot:3
- +14 SET PFSTAID=^PRPF(470,PRPFHLD1,12)
- +15 DO NODE12^PRPFDR1
- End DoDot:3
- +16 IF $DATA(^DIC(4,^PRPF(470,PRPFHLD1,12),99))
- IF $PIECE(^DIC(4,^PRPF(470,PRPFHLD1,12),99),"^",1)=""
- Begin DoDot:3
- +17 SET PFSTAID="ERRBADID1"
- +18 DO NODE12^PRPFDR1
- End DoDot:3
- +19 IF '$DATA(^DIC(4,^PRPF(470,PRPFHLD1,12),99))
- Begin DoDot:3
- +20 SET PFSTAID="ERRBADID"
- +21 DO NODE12^PRPFDR1
- End DoDot:3
- End DoDot:2
- +22 IF '$DATA(^PRPF(470,PRPFHLD1,12))
- SET PFSTAID="ERRNOID"
- DO NODE12X^PRPFDR1
- +23 IF $DATA(^PRPF(470,PRPFHLD1,12))
- IF $GET(^PRPF(470,PRPFHLD1,12))=""
- Begin DoDot:2
- +24 SET PFSTAID="ERRNOID1"
- +25 DO NODE12X^PRPFDR1
- End DoDot:2
- +26 if $GET(^PRPF(470,PRPFHLD1,0))'=""
- DO NODE0^PRPFDR5
- +27 if $GET(^PRPF(470,PRPFHLD1,0))=""
- DO NODE0X^PRPFDR5
- +28 if $GET(^PRPF(470,PRPFHLD1,1))'=""
- DO NODE1^PRPFDR4
- +29 if $GET(^PRPF(470,PRPFHLD1,1))=""
- DO NODE1X^PRPFDR4
- +30 if $GET(^PRPF(470,PRPFHLD1,2))'=""
- DO NODE2^PRPFDR4
- +31 if $ORDER(^PRPF(470,PRPFHLD1,4,0))>0
- DO NODE4^PRPFDR1
- +32 if $ORDER(^PRPF(470,PRPFHLD1,5,0))>0
- DO NODE5^PRPFDR1
- +33 if $ORDER(^PRPF(470,PRPFHLD1,6,0))>0
- DO NODE6^PRPFDR4
- End DoDot:1
- +34 QUIT
- +35 ;***************************************************************
- COMPU ; SPECIFIC PATIENT INFO LOOKUP
- +1 SET PFNAME=$PIECE($GET(^DPT(PRPFHLD1,0)),"^",1)
- +2 SET PFSSN=$PIECE($GET(^DPT(PRPFHLD1,0)),"^",9)
- +3 IF PFNAME=""
- IF PFSSN'=""
- SET PFNAME="NAME-MISSING-SSN#"_PFSSN
- +4 IF PFNAME=""
- IF PFSSN=""
- SET PFNAME="NAME-MISSING-NO-SSN-IEN#"_PRPFHLD1
- +5 SET PFDOB=$PIECE($GET(^DPT(PRPFHLD1,0)),"^",3)
- +6 SET PFWARD=$PIECE($GET(^DPT(PRPFHLD1,.1)),"^",1)
- +7 SET PFCLAIM=$PIECE($GET(^DPT(PRPFHLD1,.31)),"^",3)
- +8 SET PFADDR1=$PIECE($GET(^DPT(PRPFHLD1,.11)),"^",1)
- +9 SET PFADDR2=$PIECE($GET(^DPT(PRPFHLD1,.11)),"^",2)
- +10 SET PFADDR3=$PIECE($GET(^DPT(PRPFHLD1,.11)),"^",3)
- +11 SET PFCITY=$PIECE($GET(^DPT(PRPFHLD1,.11)),"^",4)
- +12 SET PFSTATE=$PIECE($GET(^DPT(PRPFHLD1,.11)),"^",5)
- +13 SET PFZIP=$PIECE($GET(^DPT(PRPFHLD1,.11)),"^",6)
- +14 SET PFSITE=$PIECE($$SITE^VASITE(),"^",3)
- +15 if PFSITE=""
- SET PFSITE="###"
- +16 SET PFAUTH=$PIECE(^PRPF(470,PRPFHLD1,0),"^",13)
- +17 QUIT
