Changeset 636 for FOIAVistA/tag/r/IHS_ROUTINES-AUP/AUPNPAT.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• IHS_ROUTINES-AUP/AUPNPAT.m (modified) (1 diff)

FOIAVistA/tag/r/IHS_ROUTINES-AUP/AUPNPAT.m

@@ -1 @@
-AUPNPAT ;IHS/OHPRD/EDE - POST SELECTION SETS FOR PATIENT LOOKUP ; 24-MAY-1993
- ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
- ;;93.2;IHS PATIENT DICTIONARIES.;;JUL 01, 1993
+AUPNPAT ; IHS/CMI/LAB - POST SELECTION SETS FOR PATIENT LOOKUP ;10/10/06  08:57
+ ;;1.0;PCE PATIENT CARE ENCOUNTER;**167**;Aug 12, 1996;Build 22
+ ; Modified from FOIA RPMS,
+ ; Copyright (C) 2007 WorldVistA
+ ;
+ ; This program is free software; you can redistribute it and/or modify
+ ; it under the terms of the GNU General Public License as published by
+ ; the Free Software Foundation; either version 2 of the License, or
+ ; (at your option) any later version.
+ ;
+ ; This program is distributed in the hope that it will be useful,
+ ; but WITHOUT ANY WARRANTY; without even the implied warranty of
+ ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ ; GNU General Public License for more details.
+ ;
+ ; You should have received a copy of the GNU General Public License
+ ; along with this program; if not, write to the Free Software
+ ; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
  ;
  ; This routine sets standard patient variables
- ;
+ ;IHS/SET/GTH AUPN*99.1*8 10/04/2002 Removed all refs to AUPN*93.2*3.
 START ;
  S:$D(X) AUPNPATX=X
  S AUPNPAT=+Y
  S AUPNSEX=$P(^DPT(AUPNPAT,0),U,2),AUPNDOB=$P(^(0),U,3),AUPNDOD="" S:$D(^(.35)) AUPNDOD=$P(^(.35),U,1)
- S X2=AUPNDOB,X1=$S('AUPNDOD:DT,AUPNDOD:AUPNDOD,1:DT) D ^%DTC S AUPNDAYS=X K X,X1,X2
+ S X2=AUPNDOB,X1=$S('AUPNDOD:DT,AUPNDOD:AUPNDOD,1:DT)
+ D ^%DTC
+ S AUPNDAYS=X
+ K X,X1,X2
  S:$D(AUPNPATX) X=AUPNPATX
  K %T,%Y,AUPNPATX
+ ;New EHR code    ;DAOU/WCJ   2/8/05
+ ; VOE change to permit VA, IHS and VOE to use the same code
+ Q:$G(DUZ("AG"))="V"  ; WV/CJS
+ ;End EHR modifications
+ S DFN=AUPNPAT
+ S SSN=$$SSN(AUPNPAT)
+ S AGE=$$AGE(AUPNPAT)
+ S DOB=$$DOB(AUPNPAT)
+ S SEX=$$SEX(AUPNPAT)
  Q
  ;
-KILL ; KILL VARIABLES SET BY THIS ROUTINE
+KILL ;PEP - KILL VARIABLES SET BY THIS ROUTINE
  K AUPNPAT,AUPNSEX,AUPNDOB,AUPNDOD,AUPNDAYS
+ ;New EHR code    ;DAOU/WCJ   2/8/05
+ ; VOE change to permit VA, IHS and VOE to use the same code
+ Q:$G(DUZ("AG"))'="E"
+ ;End EHR modifications
+ K AGE,DFN,DOB,SEX,SSN
  Q
+ ;
+ ;  NOTE TO PROGRAMMERS:
+ ;   All parameters are required, except the Format parameter ("F").
+ ;   The default for the Format parameter is the internal format of
+ ;   the returned value.
+ ;
+AGE(DFN,D,F) ;PEP - Given DFN, return Age.
+ ;return age on date d in format f (defaults to DT and age in years)
+ Q $$AGE^AUPNPAT3(DFN,$G(D),$G(F))
+ ;
+BEN(DFN,F) ;PEP - returns classifications/beneficiary in format F.
+ Q $$BEN^AUPNPAT3(DFN,$G(F))
+ ;
+BENYN(DFN) ;PEP - Return BEN/Non-BEN Status.
+ Q $$BEN^AUPNPAT1(DFN)
+ ;
+CDEATH(DFN,F) ;PEP - returns Cause of Death in F format
+ Q $$CDEATH^AUPNPAT3(DFN,$G(F))
+ ;
+COMMRES(DFN,F) ;PEP - Given DFN, return comm of res in F format
+ Q $$COMMRES^AUPNPAT3(DFN,$G(F))
+ ;
+DEC(PID) ;PEP - RETURN DECRYPTED PATIENT IDENTIFIER
+ G DEC^AUPNPAT4
+ ;----------
+ENC(DFN) ;PEP
+ G ENC^AUPNPAT4
+ ;----------
+DOB(DFN,F) ;PEP - Given DFN, return Date of Birth according to F.
+ Q $$DOB^AUPNPAT3(DFN,$G(F))
+ ;
+DOD(DFN,F) ;PEP - Given DFN, return Date of Death in FM format.
+ Q $$DOD^AUPNPAT3(DFN,$G(F))
+ ;
+ELIGSTAT(DFN,F) ;PEP - returns eligibility status in F format
+ Q $$ELIGSTAT^AUPNPAT3(DFN,$G(F))
+ ;
+HRN(DFN,L,F) ;PEP
+ ;f patch 4 05/08/96
+ Q $$HRN^AUPNPAT3(DFN,L,$G(F))
+ ;
+MCD(P,D) ;PEP - Is patient P medicaid eligible on date D?
+ Q $$MCD^AUPNPAT2(P,D)
+ ;
+MCDPN(P,D,F) ;PEP - return medicaid plan name for patient P on date D in form F.
+ Q $$MCDPN^AUPNPAT2(P,D,$G(F))
+ ;
+MCR(P,D) ;PEP - Is patient P medicare eligible on date D?
+ Q $$MCR^AUPNPAT2(P,D)
+ ;
+PI(P,D) ;PEP - Is patient P private insurance eligible on date D?
+ Q $$PI^AUPNPAT2(P,D)
+ ;
+PIN(P,D,F) ;PEP - return private insurer name for patient P on date D in form F.
+ Q $$PIN^AUPNPAT2(P,D,$G(F))
+ ;
+SEX(DFN) ;PEP - Given DFN, return Sex.
+ Q $$SEX^AUPNPAT3(DFN)
+ ;
+SSN(DFN) ;PEP - Given DFN, return SSN.
+ Q $$SSN^AUPNPAT3(DFN)
+ ;
+TRIBE(DFN,F) ;PEP - Given DFN, return Tribe in F format
+ Q $$TRIBE^AUPNPAT3(DFN,$G(F))
+ ;
+ ;Begin New Code;IHS/SET/GTH AUPN*99.1*8 10/04/2002
+RR(P,D) ;PEP -  Is patient P railroad eligible on date D?
+ Q $$RRE^AUPNPAT2(P,D)
+ ;End New Code;IHS/SET/GTH AUPN*99.1*8 10/04/2002