source: FOIAVistA/trunk/r/REMOTE_ORDER_ENTRY_SYSTEM-RMPF-RMPJ/RMPFRPC1.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1RMPFRPC1 ;DDC/PJU - Module to get demographics from patient files ;7/8/04
2 ;;3.0;REMOTE ORDER/ENTRY SYSTEM;**1**;11/1/02
3 ;;Called from RMPFDEMOG
4START(RE,DFN) ;see description at end of program
5 ;;input: array name by ref, DFN
6 ;;output: 2 char term used in name-value pairs for URL
7 ;;will return to the Delphi app subscripts in same order
8 ;created during calculation in the RE array (passed by reference)
9 ;PD = RE(0)=date of death msg or ""
10 ;NM = RE(11)=name
11 ;SS = RE(12)=SSN
12 ;BD = RE(13)=DOB
13 ;L1 = RE(14)=current ad1
14 ;L2 = RE(15)=current ad2
15 ;L3 = RE(16)=current ad3
16 ;CI = RE(17)=current city
17 ;ST = RE(18)=current st
18 ;ZP = RE(19)=current zip
19 ;TD = RE(20)=t start date
20 ;TE = RE(21)=t end date
21 ;PN = RE(22)=current phone
22 ;ED = RE(23)=eligibility status date FM
23 ;EL = RE(24)=R3 eligibility code
24 ;ES = RE(25)=eligibility status
25 ;SR = RE(26)=sensitive record
26 ;ER = RE(27)=error msg
27 ;PR = RE(28)=primary elig
28 ;GP = RE(29)=priority group
29 ;ICN= RE(30)=Integration Control Number for MPI
30 I '$G(DFN) D G END
31 .S ER="**ERROR** Must have a DFN to run routine RMPFRPC "
32 K RE ;can set param to clear between calls
33N N ARR,BD,CL,CI,ED,EL,ER,ES,GP,ICN,L1,L2,L3
34 N NM,PD,PN,PR,SR,SS,ST,TE,TD,VT,ZP
35 S (BD,CL,CI,ED,EL,ER,ES,GP,ICN,L1,L2,L3)=""
36 S (NM,PD,PN,PR,SR,SS,ST,TE,TD,VT,ZP)=""
37 F X=0,11:1:30 S RE(X)=""
38D D DEM^VADPT ;sets up VADM() - demographic variables *** ck for errors
39 I $G(VAERR) D G END
40 .S ER="**ERROR** Problem in retrieving Demographic values"
41 I $D(^DGSL(38.1,"B",DFN)) D ;ck for sensitive record
42 .S SR=$O(^DGSL(38.1,"B",DFN,0)) ;IA#767 after approval from Mary Marks/Cameron Schlehuber
43 .I SR,$P($G(^DGSL(38.1,SR,0)),U,2) S RE(26)=1
44 S NM=$G(VADM(1)),RE(11)=NM ;name
45 S SS=$P($G(VADM(2)),U,1),RE(12)=SS ;ssn
46 S BD=$G(VADM(3)),RE(13)=BD ;DOB
47 D ADD^VADPT ;sets up VAPA() *** get current addr and ck errors
48 I $G(VAERR) D G END
49 .S ER="**ERROR** Problem in retrieving Address values"
50 S L1=$G(VAPA(1)),RE(14)=L1
51 S L2=$G(VAPA(2)),RE(15)=L2
52 S L3=$G(VAPA(3)),RE(16)=L3
53 S CI=$G(VAPA(4)),RE(17)=CI
54 S ST=$P($G(VAPA(5)),U,1) ;State file pointer
55 I 'ST D G END
56 .S ER="**ERROR** Invalid State entry in PATIENT file"
57 E S X=ST,DIC="5",DIC(0)="NZ" D ^DIC K DIC D G:$L(ER) END
58 .I +Y<1 K Y D Q ;2/6/04 chg'd to part of ELSE
59 ..S ER="**ERROR** Patient State not in the STATE file"
60 .S ST=$P(Y(0),U,2) K Y ;State abbrev
61 S RE(18)=$P($G(VAPA(5)),U,1)_U_ST
62 S ZP=$S($G(VAPA(11)):VAPA(11),1:VAPA(6)),RE(19)=$P(ZP,U,1)
63 S TD=$G(VAPA(9)),RE(20)=TD
64 S TE=$G(VAPA(10)),RE(21)=TE
65 S PN=$G(VAPA(8)),RE(22)=PN ;OK to here
66END D START^RMPFRPC0(.ARR,DFN) ;elig variables
67 ;ARR is killed and re-set in RMPFRPC0
68 S RE(0)=$G(ARR(0)) ;FM DOD ^ external
69 S RE(23)=$G(ARR(1)) ;eligibility FM status date
70 S RE(24)=$G(ARR(2)) ;R3 calculated eligibility code OR
71 S:$L($G(ARR(8))) RE(24)=$G(ARR(8)) ;code^approval/disapproval^PSAS USER NAME
72 S RE(25)=$P($G(ARR(3)),U,1) ;eligibility status
73 S RE(26)=$G(ARR(4)) ;0 OR 1 FOR sensitive record
74 I $L($G(ER)) S RE(27)=ER ;error msg from VADPT calls
75 E S RE(27)=$G(ARR(5)) ;error msg from elig call
76 S RE(28)=$G(ARR(6)) ;prim elig
77 S RE(29)=$G(ARR(7)) ;priority group
78 S X="MPIF001" X ^%ZOSF("TEST")
79 I $T S ICN=$$GETICN^MPIF001(DFN)
80 S:(ICN<1) ICN="" ;"***ICN NOT FOUND***"
81 S RE(30)=ICN
82EXIT F X=11:1:30 S RE(X)=$$CLEAN(RE(X))
83 K S0,S1,S2,S6,YY,POP
84 D KVAR^VADPT ;kill VADPT variables
85 Q
86CLEAN(RMVAR) ;Remove symbols that should not go through URL
87 N RMPFRTN
88 S RMPFRTN=$TR(RMVAR,"@#%?&/\","")
89ENDC Q RMPFRTN
90 ;
91EXAMP ;return array to calling application
92 ;sorts numerically by orig subscript
93 ;RE(0)= DOD numeric and text
94 ;RE(1)= name text
95 ;RE(2)= SSN
96 ;RE(3)= DOB numeric and text
97 ;RE(4)= current address line 1
98 ;RE(5)= "" line 2
99 ;RE(6)= "" line 3
100 ;RE(7)= "" city
101 ;RE(8)= "" numeric and abbrev state
102 ;RE(9)= "" zip
103 ;RE(10)= temp start date numeric ^ text
104 ;RE(11)= temp end date numeric ^ text
105 ;RE(12)= current phone
106 ;RE(13)= elig status date numeric ^ text
107 ;RE(14)= elig
108 ;RE(15)= elig status (V^VERIVIED)
109 ;RE(16)= sensitive record (1 or '')
110 ;RE(17)=error msg
111 ;RE(18)=primary elig
112 ;RE(19)=priority group
113 ;RE(20)=integration control number ICN
114 ;
115 ;RPCBroker lookup is done to retrieve the patient DFN.
116 ;A call is then made to this routine through the RMPFDEMOG RPC.
117 ;From the PATIENT file, we get the name, SSN, date of birth,
118 ;current address, and temporary address parameters.
Note: See TracBrowser for help on using the repository browser.