Index: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGREG.m
===================================================================
--- FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGREG.m	(revision 631)
+++ FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGREG.m	(revision 636)
@@ -1,4 +1,12 @@
-DGREG ;ALB/JDS,MRL/PJR/PHH-REGISTER PATIENT ; 8/24/05 1:40pm
- ;;5.3;Registration;**1,32,108,147,149,182,245,250,513,425,533,574,563,624,658**;Aug 13, 1993
+DGREG ;ALB/JDS,MRL/PJR/PHH-REGISTER PATIENT ;1/27/07  13:08
+ ;;5.3;Registration;**1,32,108,147,149,182,245,250,513,425,533,574,563,624,658,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.
+ ;
 START ;
 EN D LO^DGUTL S DGCLPR=""
@@ -10,5 +18,32 @@
  I '$D(DGIO),$P(^DG(43,1,0),U,30) S %ZIS="N",IOP="HOME" D ^%ZIS I $D(IOS),IOS,$D(^%ZIS(1,+IOS,99)),$D(^%ZIS(1,+^(99),0)) S Y=$P(^(0),U,1) W !,"Using closest printer ",Y,! F I=10,"PRF","RT","HS" S DGIO(I)=Y
 A D ENDREG($G(DFN))
- W !! S DIC=2,DIC(0)="ALEQM",DLAYGO=2 K DIC("S"),DIC("B") D ^DIC K DLAYGO G Q1:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) N Y D PAUSE^DG10 D BEGINREG(DFN) I DGNEW D NEW^DGRP
+ ;
+ ; ** VOE change 1 of 4: DAOU/WCJ 2/1/2005,VA/CJS,WV/TOAD 1/5/2006 **
+ ;
+ ; if not VA agency code, add DIC("DR") to default some identifiers and
+ ; skip others also, improve readability
+ ;
+ ; before change:
+ ; W !! S DIC=2,DIC(0)="ALEQM",DLAYGO=2 K DIC("S"),DIC("B") D ^DIC K DLAYGO G Q1:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) N Y D PAUSE^DG10 D BEGINREG(DFN) I DGNEW D NEW^DGRP
+ ;
+ ; after change:
+ W !!
+ N Y,DGREGY S DGREGY=1 D  I DGREGY<0 G Q1
+ . N DIC S DIC=2 ; Patient file
+ . S DIC(0)="ALEQM" ; ask, laygo, echo, question, and multi-index
+ . N DLAYGO S DLAYGO=2 ; override file access by user: allow laygo
+ . I $G(DUZ("AG"))'="V" D  ;adjust identifiers asked for VOE
+ . . S DIC("DR")=".02;.03;994;.301///N;391///VISTA OFFICE EHR;1901///N;.09"
+ . ;
+ . D ^DIC ; Select Patient
+ . ;
+ . I Y<0 S DGREGY=-1 Q
+ . K DIC("DR")
+ . S (DFN,DA)=+Y
+ . S DGNEW=$P(Y,"^",3) ; new patient?
+ . N Y D PAUSE^DG10 ; prompt user before continuing
+ . D BEGINREG(DFN) ; lock patient record
+ ;
+ ; ** end of VOE change 1 **
  ;
  ;; ask to continue if patient died - DG*5.3*563 - pjr 10/12/04
@@ -18,10 +53,29 @@
  D CIRN
  ;
- I +$G(DGNEW) D
+ ; ** VOE change 2 of 4: DAOU/WCJ 2/1/2005,VA/CJS,WV/TOAD 1/5/2006 **
+ ;
+ I $G(DGNEW) D NEW^DGRP ; execute new patient DR string
+ ;
+ ; send CMOR query and display results only if VA agency code
+ ;
+ ; before change:
+ ; I +$G(DGNEW) D
+ ;
+ ; after change:
+ I $G(DGNEW),$G(DUZ("AG"))="V" D
+ . ;
+ . ; end of change
+ . ;
  . ; query CMOR for Patient Record Flag Assignments if NEW patient and
  . ; display results.
  . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN)
  ;
- D ROMQRY
+ ; before change:
+ ; D ROMQRY
+ ;
+ ; after change:
+ I $G(DUZ("AG"))="V" D ROMQRY
+ ;
+ ; ** end of VOE change 2 **
  ;
  S (DGFC,CURR)=0
@@ -30,5 +84,17 @@
  D HINQ^DG10
  I $D(^DIC(195.4,1,"UP")) I ^("UP") D ADM^RTQ3
- D REG^IVMCQ($G(DFN))  ; send financial query  
+ ;
+ ; ** VOE change 3 of 4: DAOU/WCJ 2/1/2005,VA/CJS,WV/TOAD 1/5/2006 **
+ ;
+ ; send financial query only for VA agency code
+ ;
+ ; before change:
+ ; D REG^IVMCQ($G(DFN))  ; send financial query
+ ;
+ ; after change:
+ I $G(DUZ("AG"))="V" D REG^IVMCQ($G(DFN)) ; send financial query
+ ;
+ ; ** end of VOE change 3 **
+ ;
  G A1
  ;
@@ -62,4 +128,15 @@
  ;
  S DA=DFN1,DIE("NO^")="",DA(1)=DFN,DP=2.101,DR="1///"_$S(SEEN=2:2,CURR=1:1,1:0)_";Q;2"_$S(CURR=1:"///3",1:"")_";2.1;3//"_$S($P(^DG(43,1,"GL"),"^",2):"",1:"/")_$S($D(^DG(40.8,+$P(^DG(43,1,"GL"),"^",3),0)):$P(^(0),"^",1),1:"")_";4////"_DUZ
+ ;
+ ; ** VOE change 4 of 4: DAOU/JLG 2/7/2005,VA/CJS,WV/TOAD 1/5/2006 **
+ ;
+ ; for VOE or IHS agency codes, add the following:
+ ; force TYPE OF CARE with ALL OTHER
+ ;
+ I $G(DUZ("AG"))="E"!($G(DUZ("AG"))="I") D
+ . S DR="1///"_$S(SEEN=2:2,CURR=1:1,1:0)_";Q;2"_$S(CURR=1:"///3",1:"")_";2.1///5;3//"_$S($P(^DG(43,1,"GL"),"^",2):"",1:"/")_$S($D(^DG(40.8,+$P(^DG(43,1,"GL"),"^",3),0)):$P(^(0),"^",1),1:"")_";4////"_DUZ
+ ;
+ ; ** end of VOE change 4 **
+ ;
  D EL K DIC("A") N DGNDLOCK S DGNDLOCK=DIE_DFN1_")" L +@DGNDLOCK:2 G:'$T MSG D ^DIE L -@DGNDLOCK
  I $D(DTOUT) D  G Q
