source: WorldVistAEHR/trunk/r/IHS_ROUTINES-AUP/AUPNPAT.m@ 619

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1AUPNPAT ; IHS/CMI/LAB - POST SELECTION SETS FOR PATIENT LOOKUP ;10/10/06 08:57
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**167**;Aug 12, 1996;Build 22
3 ; Modified from FOIA RPMS,
4 ; Copyright (C) 2007 WorldVistA
5 ;
6 ; This program is free software; you can redistribute it and/or modify
7 ; it under the terms of the GNU General Public License as published by
8 ; the Free Software Foundation; either version 2 of the License, or
9 ; (at your option) any later version.
10 ;
11 ; This program is distributed in the hope that it will be useful,
12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ; GNU General Public License for more details.
15 ;
16 ; You should have received a copy of the GNU General Public License
17 ; along with this program; if not, write to the Free Software
18 ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
19 ;
20 ; This routine sets standard patient variables
21 ;IHS/SET/GTH AUPN*99.1*8 10/04/2002 Removed all refs to AUPN*93.2*3.
22START ;
23 S:$D(X) AUPNPATX=X
24 S AUPNPAT=+Y
25 S AUPNSEX=$P(^DPT(AUPNPAT,0),U,2),AUPNDOB=$P(^(0),U,3),AUPNDOD="" S:$D(^(.35)) AUPNDOD=$P(^(.35),U,1)
26 S X2=AUPNDOB,X1=$S('AUPNDOD:DT,AUPNDOD:AUPNDOD,1:DT)
27 D ^%DTC
28 S AUPNDAYS=X
29 K X,X1,X2
30 S:$D(AUPNPATX) X=AUPNPATX
31 K %T,%Y,AUPNPATX
32 ;New EHR code ;DAOU/WCJ 2/8/05
33 ; VOE change to permit VA, IHS and VOE to use the same code
34 Q:$G(DUZ("AG"))="V" ; WV/CJS
35 ;End EHR modifications
36 S DFN=AUPNPAT
37 S SSN=$$SSN(AUPNPAT)
38 S AGE=$$AGE(AUPNPAT)
39 S DOB=$$DOB(AUPNPAT)
40 S SEX=$$SEX(AUPNPAT)
41 Q
42 ;
43KILL ;PEP - KILL VARIABLES SET BY THIS ROUTINE
44 K AUPNPAT,AUPNSEX,AUPNDOB,AUPNDOD,AUPNDAYS
45 ;New EHR code ;DAOU/WCJ 2/8/05
46 ; VOE change to permit VA, IHS and VOE to use the same code
47 Q:$G(DUZ("AG"))'="E"
48 ;End EHR modifications
49 K AGE,DFN,DOB,SEX,SSN
50 Q
51 ;
52 ; NOTE TO PROGRAMMERS:
53 ; All parameters are required, except the Format parameter ("F").
54 ; The default for the Format parameter is the internal format of
55 ; the returned value.
56 ;
57AGE(DFN,D,F) ;PEP - Given DFN, return Age.
58 ;return age on date d in format f (defaults to DT and age in years)
59 Q $$AGE^AUPNPAT3(DFN,$G(D),$G(F))
60 ;
61BEN(DFN,F) ;PEP - returns classifications/beneficiary in format F.
62 Q $$BEN^AUPNPAT3(DFN,$G(F))
63 ;
64BENYN(DFN) ;PEP - Return BEN/Non-BEN Status.
65 Q $$BEN^AUPNPAT1(DFN)
66 ;
67CDEATH(DFN,F) ;PEP - returns Cause of Death in F format
68 Q $$CDEATH^AUPNPAT3(DFN,$G(F))
69 ;
70COMMRES(DFN,F) ;PEP - Given DFN, return comm of res in F format
71 Q $$COMMRES^AUPNPAT3(DFN,$G(F))
72 ;
73DEC(PID) ;PEP - RETURN DECRYPTED PATIENT IDENTIFIER
74 G DEC^AUPNPAT4
75 ;----------
76ENC(DFN) ;PEP
77 G ENC^AUPNPAT4
78 ;----------
79DOB(DFN,F) ;PEP - Given DFN, return Date of Birth according to F.
80 Q $$DOB^AUPNPAT3(DFN,$G(F))
81 ;
82DOD(DFN,F) ;PEP - Given DFN, return Date of Death in FM format.
83 Q $$DOD^AUPNPAT3(DFN,$G(F))
84 ;
85ELIGSTAT(DFN,F) ;PEP - returns eligibility status in F format
86 Q $$ELIGSTAT^AUPNPAT3(DFN,$G(F))
87 ;
88HRN(DFN,L,F) ;PEP
89 ;f patch 4 05/08/96
90 Q $$HRN^AUPNPAT3(DFN,L,$G(F))
91 ;
92MCD(P,D) ;PEP - Is patient P medicaid eligible on date D?
93 Q $$MCD^AUPNPAT2(P,D)
94 ;
95MCDPN(P,D,F) ;PEP - return medicaid plan name for patient P on date D in form F.
96 Q $$MCDPN^AUPNPAT2(P,D,$G(F))
97 ;
98MCR(P,D) ;PEP - Is patient P medicare eligible on date D?
99 Q $$MCR^AUPNPAT2(P,D)
100 ;
101PI(P,D) ;PEP - Is patient P private insurance eligible on date D?
102 Q $$PI^AUPNPAT2(P,D)
103 ;
104PIN(P,D,F) ;PEP - return private insurer name for patient P on date D in form F.
105 Q $$PIN^AUPNPAT2(P,D,$G(F))
106 ;
107SEX(DFN) ;PEP - Given DFN, return Sex.
108 Q $$SEX^AUPNPAT3(DFN)
109 ;
110SSN(DFN) ;PEP - Given DFN, return SSN.
111 Q $$SSN^AUPNPAT3(DFN)
112 ;
113TRIBE(DFN,F) ;PEP - Given DFN, return Tribe in F format
114 Q $$TRIBE^AUPNPAT3(DFN,$G(F))
115 ;
116 ;Begin New Code;IHS/SET/GTH AUPN*99.1*8 10/04/2002
117RR(P,D) ;PEP - Is patient P railroad eligible on date D?
118 Q $$RRE^AUPNPAT2(P,D)
119 ;End New Code;IHS/SET/GTH AUPN*99.1*8 10/04/2002
Note: See TracBrowser for help on using the repository browser.