Ignore:
Timestamp:
Dec 4, 2009, 8:26:01 PM (15 years ago)
Author:
George Lilly
Message:

WorldVistAEHR overlayed on FOIAVistA

Location:
FOIAVistA/tag/r
Files:
1 edited
1 copied

Legend:

Unmodified
Added
Removed
  • FOIAVistA/tag/r/IHS_ROUTINES-AUP/AUPNPAT.m

    r628 r636  
    1 AUPNPAT ;IHS/OHPRD/EDE - POST SELECTION SETS FOR PATIENT LOOKUP ; 24-MAY-1993
    2  ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
    3  ;;93.2;IHS PATIENT DICTIONARIES.;;JUL 01, 1993
     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
    419 ;
    520 ; This routine sets standard patient variables
    6  ;
     21 ;IHS/SET/GTH AUPN*99.1*8 10/04/2002 Removed all refs to AUPN*93.2*3.
    722START ;
    823 S:$D(X) AUPNPATX=X
    924 S AUPNPAT=+Y
    1025 S AUPNSEX=$P(^DPT(AUPNPAT,0),U,2),AUPNDOB=$P(^(0),U,3),AUPNDOD="" S:$D(^(.35)) AUPNDOD=$P(^(.35),U,1)
    11  S X2=AUPNDOB,X1=$S('AUPNDOD:DT,AUPNDOD:AUPNDOD,1:DT) D ^%DTC S AUPNDAYS=X K X,X1,X2
     26 S X2=AUPNDOB,X1=$S('AUPNDOD:DT,AUPNDOD:AUPNDOD,1:DT)
     27 D ^%DTC
     28 S AUPNDAYS=X
     29 K X,X1,X2
    1230 S:$D(AUPNPATX) X=AUPNPATX
    1331 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)
    1441 Q
    1542 ;
    16 KILL ; KILL VARIABLES SET BY THIS ROUTINE
     43KILL ;PEP - KILL VARIABLES SET BY THIS ROUTINE
    1744 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
    1850 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 TracChangeset for help on using the changeset viewer.