source: FOIAVistA/trunk/r/INTEGRATED_PATIENT_FUNDS-PRPF-PFXIP/PRPFDR3.m@ 632

Last change on this file since 632 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1PRPFDR3 ;BAYPINES/MJE VPFS DATA MIGRATION ROUTINE 3 ;05/15/03
2 ;;3.0;PATIENT FUNDS DIAG V5.9;**15**;JUNE 1, 1989
3 ;ENTRY AT LINETAG ONLY
4 Q
5RPC(RESULTS,PARAM1,PARAM2) ;ENTRY POINT FOR VPFS RPC
6 S PRPFJ=PARAM2
7 S PRPFSEG=PARAM1
8 I PRPFSEG>1 D SENDSEG Q
9TESTRPC ;ENTRY POINT FOR TESTING
10 K ^TMP("PRPF_DIAGVL")
11 D SETUP^PRPFDR2
12 S CNTSEG=1
13 S CNTTOT=0
14 D XSUM
15 D XREP
16 S RESULTS=$NA(^TMP("PRPF_DIAGVL",$J,1))
17 D KILLIT^PRPFDR4
18 Q
19SENDSEG ;SEND A SEGMENT OF DATA TO MIGRATION JAVA APP
20 S RESULTS=$NA(^TMP("PRPF_DIAGVL",PRPFJ,PRPFSEG))
21 Q
22SEG ;SET UP NEW SEGMENT NODE
23 D:PRPFCNTR=10000
24 .S CNTSEG=CNTSEG+1
25 .S CNTTOT=CNTTOT+PRPFCNTR
26 .S PRPFCNTR=0
27 Q
28XREP S (PFX,PFY,PFZ,PFNAME)=""
29 F S PFX=$O(^TMP("PRPF_DIAGX",$J,PFX)) Q:PFX="" D
30 .F S PFY=$O(^TMP("PRPF_DIAGX",$J,PFX,PFY)) Q:PFY="" D
31 ..F S PFZ=$O(^TMP("PRPF_DIAGX",$J,PFX,PFY,PFZ)) Q:PFZ="" D
32 ...S PFTEMP=^TMP("PRPF_DIAGX",$J,PFX,PFY,PFZ)
33 ...S PRPFCNTR=PRPFCNTR+1
34 ...S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="STATION ID="_PFX_"^ERR#="_PFY_"^NAME="_PFZ_"^DESC="_$P(PFTEMP,"^",2)_"^VALUE=>"_$P(PFTEMP,"^",3)_"<"
35 ...D SEG
36 S CNTTOT=CNTTOT+PRPFCNTR
37 S ^TMP("PRPF_DIAGVL",$J,0)=DTIME_"^"_"DTIME"_"^"_"PRPF MIGRATION DIAGNOSTIC TEMP DATA SENT TO J2EE"
38 S ^TMP("PRPF_DIAGVL",$J,1,0)="VPFS"_U_PFSITE_U_U_U_U_"0"_U_"A1"_U_CNTREC_U_CNTTOT_U_$J
39 K ^TMP("PRPF_DIAGX")
40 Q
41XSUM ;THIS ENTRY POINT FOR VISTALINK
42 S PRPFCNTR=0
43 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="**************************************************************************"
44 D SEG
45 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="** Patient Funds Diagnostic Summary LEGACY RPC (version 5.9) **"
46 D SEG
47 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="**************************************************************************"
48 D SEG
49 D NOW^%DTC S Y=% D DD^%DT
50 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))_" **"
51 D SEG
52 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="Total accounts processed = "_CNTREC_$P(" "," ",1,7-$L(CNTREC))_" **"
53 D SEG
54 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)))_" **"
55 D SEG
56 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="**************************************************************************"
57 D SEG
58 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="Err# Field Error Total"
59 D SEG
60 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" # Name Description Count"
61 D SEG
62 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="**************************************************************************"
63 D SEG
64 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #1 NAME Name is blank "_CNTERR(1)
65 D SEG
66 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #2 NAME Name contains invalid data "_CNTERR(2)
67 D SEG
68 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #3 SSN SSN is blank "_CNTERR(3)
69 D SEG
70 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #4 SSN SSN contains invalid data "_CNTERR(4)
71 D SEG
72 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #5 SSN SSN contains duplicate value "_CNTERR(5)
73 D SEG
74 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #6 SSN SSN contains Pseudo SSN value "_CNTRPSU
75 D SEG
76 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #7 DOB DOB is blank "_CNTERR(7)
77 D SEG
78 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #8 DOB DOB contains invalid date "_CNTERR(8)
79 D SEG
80 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #9 WARD Ward loc invalid length "_CNTERR(9)
81 D SEG
82 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #10 CLAIM Claim # contains invalid data "_CNTERR(10)
83 D SEG
84 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #11 ZIP Zipcode contains invalid data "_CNTERR(11)
85 D SEG
86 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #12 REGION OFFICE Regional Office ID invalid data "_CNTERR(12)
87 D SEG
88 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #13 ICN ICN Duplicate "_CNTERR(13)
89 D SEG
90 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #14 ICN ICN unassigned or invalid "_CNTERR(14)
91 D SEG
92 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)=" #15 PROVIDER AUTHR Provider Name contains invalid data "_CNTERR(15)
93 D SEG
94 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#16 PROVID AUTH DT Date of current restriction invalid date "_CNTERR(16)
95 D SEG
96 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#17 NO DEMO REC No demographic record for account "_CNTERR(17)
97 D SEG
98 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)
99 D SEG
100 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)
101 D SEG
102 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)
103 D SEG
104 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)
105 D SEG
106 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)
107 D SEG
108 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#23 APPORTIONEE $ Apportionee amount invalid or < $0 or > $99,999 "_CNTERR(23)
109 D SEG
110 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#24 GUARDIAN $ Guardian amount invalid or < $0 or > $99,999 "_CNTERR(24)
111 D SEG
112 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#25 INSTITUT AWARD Institut award invalid or < $0 or > $99,999 "_CNTERR(25)
113 D SEG
114 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#26 OTHER ASSETS Other assets invalid or < $0 or > $99,999 "_CNTERR(26)
115 D SEG
116 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#27 STORED BALANCE Stored balance invalid or < $0 or > $99,999 "_CNTERR(27)
117 D SEG
118 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#28 STORED PRIVATE Stored private invalid or < $0 or > $99,999 "_CNTERR(28)
119 D SEG
120 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#29 STORED GRATUIT Stored gratuitous invalid or < $0 or > $99,999 "_CNTERR(29)
121 D SEG
122 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#30 RESTRCT MONTH Restricted Monthly invalid or < $0 or > $99,999 "_CNTERR(30)
123 D SEG
124 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#31 RESTRCT WEEKLY Restricted Weekly invalid or < $0 or > $99,999 "_CNTERR(31)
125 D SEG
126 S PRPFCNTR=PRPFCNTR+1 S ^TMP("PRPF_DIAGVL",$J,CNTSEG,PRPFCNTR)="*#32 RESTRCT AMT ER Restrict Mnthly amount > (5X) weekly amt "_CNTERR(32)
127 D SEG
128 D XSUM1^PRPFDR6
129 Q
Note: See TracBrowser for help on using the repository browser.