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