Changeset 636 for FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRPCE.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 )
• REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRPCE.m (modified) (3 diffs)

FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRPCE.m

@@ -1 @@
-DGRPCE ;ALB/MRL,KV,PJR,BRM,ERC - CONSISTENCY CHECKER, EDIT INCONSISTENCIES ; 12/14/04 9:42am
- ;;5.3;Registration;**121,122,175,297,342,451,626,689,653**;Aug 13, 1993;Build 2
+DGRPCE ;ALB/MRL,KV,PJR,BRM - CONSISTENCY CHECKER, EDIT INCONSISTENCIES ; 12/14/04 9:42am
+ ;;5.3;Registration;**121,122,175,297,342,451,626,689,653,634**;Aug 13, 1993;Build 28
+ ; Modified from FOIA VISTA,
+ ; 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
  ;
  ;KV;11/15/00;DG*5.3*297;Disable addition of CD Elig Code in Reg. Screens
@@ -9 +25 @@
  S DGEK=0 F I=9,10,11,12,13,14,18,19,20,22,24,36,51 Q:DGEK  I DGER[(","_I_",") S DGEK=1 Q
  I 'DGKEY(1) D:DGEK ELDR S I=15 D SASK S I=23 D SASK
+ ;New EHR code  DAOU/WCJ  2/5/05
+ ;skip veteran related fields for agency EHR
+ G NKEY:$G(DUZ("AG"))="E"
+ ;End EHR new code 
  F I=29,30,31,32,33,43,44,45,48,56 D SASK,MON:DGCCF S DGCCF=0
  G NKEY:DGKEY(3) F I=25,26,27,28,34,35 D SASK
@@ -39 +59 @@
  S DGDRC=DGDRC+1,DGDR="DR(1,2,"_DGDRC_")",@DGDR=DGD,DGD="" Q
 ELDR S DGASK=DGASK_"9,10,11,12,13,14,18,19,20,24,29,30,31,34,36,37,38,"
- I 'DGKEY(1) S DGD="391;1901;S DGVTYN=$S($D(^DPT(DFN,""VET"")):$P(^(""VET""),""^"",1),1:"""");S:X'=""Y"" Y=""@1"";.301;S:X'=""Y"" Y=""@1"";.302;@1;" D SAVE
- I 'DGKEY(2) F I=29,30,31 S DGD=$P($T(@I),";;",2,999) D SAVE
- D:DGD]"" SAVE I 'DGKEY(3) S DGD=$P($T(34),";;",2,999) D SAVE S DGD=$P($T(51),";;",2,999) D SAVE
+ ;Previous VA code prior to EHR changes
+ ;I 'DGKEY(1) S DGD="391;1901;S DGVTYN=$S($D(^DPT(DFN,""VET"")):$P(^(""VET""),""^"",1),1:"""");S:X'=""Y"" Y=""@1"";.301;S:X'=""Y"" Y=""@1"";.302;@1;" D SAVE
+ ;I 'DGKEY(2) F I=29,30,31 S DGD=$P($T(@I),";;",2,999) D SAVE
+ ;D:DGD]"" SAVE I 'DGKEY(3) S DGD=$P($T(34),";;",2,999) D SAVE S DGD=$P($T(51),";;",2,999) D SAVE
+ ;New code  DAOU/WCJ 2/5/05  Skip veteran specific fields
+ I 'DGKEY(1),$G(DUZ("AG"))'="E"  S DGD="391;1901;S DGVTYN=$S($D(^DPT(DFN,""VET"")):$P(^(""VET""),""^"",1),1:"""");S:X'=""Y"" Y=""@1"";.301;S:X'=""Y"" Y=""@1"";.302;@1;" D SAVE
+ I 'DGKEY(2),$G(DUZ("AG"))'="E"  F I=29,30,31 S DGD=$P($T(@I),";;",2,999) D SAVE
+ D:DGD]"" SAVE I 'DGKEY(3),$G(DUZ("AG"))'="E"  S DGD=$P($T(34),";;",2,999) D SAVE S DGD=$P($T(51),";;",2,999) D SAVE
+ ;End new code  DAOU/WCJ  2/5/05
  I 'DGKEY(1) D ELIG^DGRPCE1
  Q