Index: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG10.m
===================================================================
--- WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG10.m	(revision 613)
+++ WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG10.m	(revision 623)
@@ -1,166 +1,166 @@
-DG10	;ALB/MRL,DAK,AEG,PHH-LOAD/EDIT PATIENT DATA ; 1/5/2006  21:46
-	;;5.3;Registration;**32,109,139,149,182,326,513,425,574,642,658,634**;Aug 13, 1993;Build 30
-	; 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
-START	;
-	D LO^DGUTL
-	I $G(DGPRFLG)=1,$G(DGPLOC)=1 D  G Q:$G(DGRPOUT),A1
-	.; D EN^DGRPD,REG^IVMCQ($G(DFN))
-	. D EN^DGRPD
-	. Q:$G(DGRPOUT)
-	. ;
-	. ; ** start of VOE change 1 of 3: DAOU/WCJ,VA/CJS,WV/TOAD 1/5/2006 **
-	. ;
-	. ; HEC query call only wanted/needed for VA agency code
-	. ;
-	. I $G(DUZ("AG"))="V" D REG^IVMCQ($G(DFN))
-	. ;
-	. ; ** end of VOE change 1 **
-	. ;
-	. D HINQ
-	;
-A	W !! K VET,DIE,DIC,CARD S DIC=2,DLAYGO=2,DIC(0)="ALEQM" K DIC("S") D ^DIC G Q:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) K DLAYGO
-	N Y D PAUSE I DGNEW D NEW^DGRP S DA=DFN,VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0)
-	;
-	;MPI QUERY
-	;check to see if CIRN PD/MPI is installed
-	N X S X="MPIFAPI" X ^%ZOSF("TEST") G:'$T SKIP
-	K MPIFRTN
-	;
-	; ** start of VOE change 2 of 3: DAOU/WCJ,VA/CJS,WV/TOAD 1/5/2006 **
-	;
-	; MPI query call only wanted/needed for VA agency code
-	;
-	I $G(DUZ("AG"))="V"!$$GET^XPAR("SYS","DG MPI") D MPIQ^MPIFAPI(DFN)
-	;
-	; ** end of VOE change 2 **
-	;
-	K MPIFRTN
-	;
-	I +$G(DGNEW) D
-	. ; query CMOR for Patient Record Flag Assignments if NEW patient and
-	. ; display results
-	. I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN)
-	;
-SKIP	;
-	S DGELVER=0 D EN^DGRPD I $D(DGRPOUT) K DGRPOUT G A
-	;
-	; ** start of VOE change 3 of 3: DAOU/WCJ,VA/CJS,WV/TOAD 1/5/2006 **
-	;
-	; these query calls only wanted/needed for VA agency code
-	;
-	I $G(DUZ("AG"))="V" D HINQ,REG^IVMCQ($G(DFN))
-	G A1
-	;
-	; ** end of VOE change 3 **
-	;
-	;
-HINQ	;
-	S Y=$S($D(^DG(43,1,0)):^(0),1:0) I $P(Y,U,27) S X="DVBHQZ4" X ^%ZOSF("TEST") I $T D
-	.N DGROUT
-	.S DGROUT=X
-	.I $G(DFN) D
-	..N X,Y,DGRP
-	..F X=.3,.32 S DGRP(X)=$G(^DPT(DFN,X))
-	..W !,"     Money Verified: " S Y=$P(DGRP(.3),"^",6) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")
-	..W ?40,"   Service Verified: " S Y=$P(DGRP(.32),"^",2) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")
-	.D @("EN^"_DGROUT) K Y Q  ;from dgdem0
-	Q
-	;
-	;   SDIEMM is used as a flag by AMBCARE Incomplete Encounter Management 
-	;   to bypass the embossing routines when calling load/edit from IEMM
-	;
-A1	D  G H:'%,CK:%'=1 S DGRPV=0 D EN1^DGRP,MT(DFN),CP G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM) G Q:'$D(DA),EMBOS
-	.W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data"
-	.S %=1 D YN^DICN
-	.I +$G(DGNEW) Q
-	.I $$ADD^DGADDUTL($G(DFN)) ;
-	;
-H	W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue without",!?5,"editing."
-	G A1
-	;
-CK	S DGEDCN=1 D ^DGRPC,MT(DFN),CP
-	G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM)
-	I $G(DGER)[55 K DIR S DIR(0)="Y",DIR("A")="Do you wish to return to Screen #9 to enter missing Income Data? " D ^DIR K DIR
-	;G:Y ^DGRP9
-	;
-EMBOS	;W ! D EMBOS^DGQEMA G A
-	G A
-	;
-	;
-Q	K X,Y,Z,DIC,DGELVER,DGNEW,DGRPV,VET Q
-	;
-MT(DFN)	; Check if user requires a means test.  Ask user if they want to proceedif
-	; one is required
-	I '$D(SDIEMM) DO
-	.N DGREQF,DIV
-	.D EN^DGMTR
-	.I DGREQF D EDT^DGMTU(DFN,DT):$P($$MTS^DGMTU(DFN),U,2)="R"
-	.Q
-	I $D(SDIEMM) DO
-	.N DGMTI
-	.S DGMTI=$$LST^DGMTU(DFN,SCINF("ENCOUNTER"),1)
-	.I $P(DGMTI,U,4)="R" D  I 1
-	..S DGMT0=$G(^DGMT(408.31,+DGMTI,0)),DGMTDT=$P(DGMT0,"^")
-	..I '$$OKTOCONT(DGMTDT) Q
-	..S DGMTI=+DGMTI,DGMTYPT=1,DGMTACT="COM",DGMTROU="COM^DGMTEO" D EN^DGMTSC
-	.E  D WARNING
-	.Q
-	Q
-	;
-WARNING	;
-	;prints a warning to the screen about means test
-	;
-	W !!,"A means test for this encounter date was not found and may be required!"
-	W !,"Further investigation will be needed."
-	W !
-	D PAUSE
-	Q
-	;
-PAUSE	;
-	N DIR
-	S DIR(0)="FAO",DIR("A")="Press ENTER to continue " D ^DIR
-	Q
-	;
-OKTOCONT(Y)	;
-	;
-	N DIR
-	W !!,"Patient Requires a means Test"
-	X ^DD("DD")
-	W !,"Primary Means Test Required from '",Y,"'",!
-	;
-	I $D(SDIEMM),'$D(^XUSEC("SCENI MEANS TEST EDIT",DUZ)) DO  G OKQ
-	.W !,$C(7),"You do not have the appropriate IEMM Security Key.  Contact your supervisor.",!
-	.D PAUSE
-	.S Y=0
-	;
-	S DIR("A")="Do you wish to proceed with the means test at this time"
-	S DIR("B")="YES"
-	S DIR(0)="Y"
-	D ^DIR
-OKQ	Q $S(Y=1:1,1:0)
-	;
-CP	;If not (autoexempt or MTested) & no CP test this year then
-	;prompt for add/edit cp test
-	N DIV,DGIB,DGIBDT,DGX,X,DIRUT,DTOUT
-	G:'$P($G(^DG(43,1,0)),U,41) QTCP ;USE CP FLAG
-	S DGIBDT=$S($D(DFN1):9999999-DFN1,1:DT)
-	D EN^DGMTCOR
-	I +$G(DGNOCOPF) S DGMTCOR=0
-	I DGMTCOR D THRESH^DGMTCOU1(DGIBDT) D EDT^DGMTCOU(DFN,DT)
-	K DGNOCOPF
-QTCP	Q
+DG10 ;ALB/MRL,DAK,AEG,PHH-LOAD/EDIT PATIENT DATA ; 1/5/2006  21:46
+ ;;5.3;Registration;**32,109,139,149,182,326,513,425,574,642,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.
+ ;
+ ; 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
+START ;
+ D LO^DGUTL
+ I $G(DGPRFLG)=1,$G(DGPLOC)=1 D  G Q:$G(DGRPOUT),A1
+ .; D EN^DGRPD,REG^IVMCQ($G(DFN))
+ . D EN^DGRPD
+ . Q:$G(DGRPOUT)
+ . ;
+ . ; ** start of VOE change 1 of 3: DAOU/WCJ,VA/CJS,WV/TOAD 1/5/2006 **
+ . ;
+ . ; HEC query call only wanted/needed for VA agency code
+ . ;
+ . I $G(DUZ("AG"))="V" D REG^IVMCQ($G(DFN))
+ . ;
+ . ; ** end of VOE change 1 **
+ . ;
+ . D HINQ
+ ;
+A W !! K VET,DIE,DIC,CARD S DIC=2,DLAYGO=2,DIC(0)="ALEQM" K DIC("S") D ^DIC G Q:Y<0 S (DFN,DA)=+Y,DGNEW=$P(Y,"^",3) K DLAYGO
+ N Y D PAUSE I DGNEW D NEW^DGRP S DA=DFN,VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0)
+ ;
+ ;MPI QUERY
+ ;check to see if CIRN PD/MPI is installed
+ N X S X="MPIFAPI" X ^%ZOSF("TEST") G:'$T SKIP
+ K MPIFRTN
+ ;
+ ; ** start of VOE change 2 of 3: DAOU/WCJ,VA/CJS,WV/TOAD 1/5/2006 **
+ ;
+ ; MPI query call only wanted/needed for VA agency code
+ ;
+ I $G(DUZ("AG"))="V"!$$GET^XPAR("SYS","DG MPI") D MPIQ^MPIFAPI(DFN)
+ ;
+ ; ** end of VOE change 2 **
+ ;
+ K MPIFRTN
+ ;
+ I +$G(DGNEW) D
+ . ; query CMOR for Patient Record Flag Assignments if NEW patient and
+ . ; display results
+ . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN)
+ ;
+SKIP ;
+ S DGELVER=0 D EN^DGRPD I $D(DGRPOUT) K DGRPOUT G A
+ ;
+ ; ** start of VOE change 3 of 3: DAOU/WCJ,VA/CJS,WV/TOAD 1/5/2006 **
+ ;
+ ; these query calls only wanted/needed for VA agency code
+ ;
+ I $G(DUZ("AG"))="V" D HINQ,REG^IVMCQ($G(DFN))
+ G A1
+ ;
+ ; ** end of VOE change 3 **
+ ;
+ ;
+HINQ ;
+ S Y=$S($D(^DG(43,1,0)):^(0),1:0) I $P(Y,U,27) S X="DVBHQZ4" X ^%ZOSF("TEST") I $T D
+ .N DGROUT
+ .S DGROUT=X
+ .I $G(DFN) D
+ ..N X,Y,DGRP
+ ..F X=.3,.32 S DGRP(X)=$G(^DPT(DFN,X))
+ ..W !,"     Money Verified: " S Y=$P(DGRP(.3),"^",6) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")
+ ..W ?40,"   Service Verified: " S Y=$P(DGRP(.32),"^",2) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")
+ .D @("EN^"_DGROUT) K Y Q  ;from dgdem0
+ Q
+ ;
+ ;   SDIEMM is used as a flag by AMBCARE Incomplete Encounter Management 
+ ;   to bypass the embossing routines when calling load/edit from IEMM
+ ;
+A1 D  G H:'%,CK:%'=1 S DGRPV=0 D EN1^DGRP,MT(DFN),CP G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM) G Q:'$D(DA),EMBOS
+ .W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data"
+ .S %=1 D YN^DICN
+ .I +$G(DGNEW) Q
+ .I $$ADD^DGADDUTL($G(DFN)) ;
+ ;
+H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue without",!?5,"editing."
+ G A1
+ ;
+CK S DGEDCN=1 D ^DGRPC,MT(DFN),CP
+ G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM)
+ I $G(DGER)[55 K DIR S DIR(0)="Y",DIR("A")="Do you wish to return to Screen #9 to enter missing Income Data? " D ^DIR K DIR
+ ;G:Y ^DGRP9
+ ;
+EMBOS ;W ! D EMBOS^DGQEMA G A
+ G A
+ ;
+ ;
+Q K X,Y,Z,DIC,DGELVER,DGNEW,DGRPV,VET Q
+ ;
+MT(DFN) ; Check if user requires a means test.  Ask user if they want to proceedif
+ ; one is required
+ I '$D(SDIEMM) DO
+ .N DGREQF,DIV
+ .D EN^DGMTR
+ .I DGREQF D EDT^DGMTU(DFN,DT):$P($$MTS^DGMTU(DFN),U,2)="R"
+ .Q
+ I $D(SDIEMM) DO
+ .N DGMTI
+ .S DGMTI=$$LST^DGMTU(DFN,SCINF("ENCOUNTER"),1)
+ .I $P(DGMTI,U,4)="R" D  I 1
+ ..S DGMT0=$G(^DGMT(408.31,+DGMTI,0)),DGMTDT=$P(DGMT0,"^")
+ ..I '$$OKTOCONT(DGMTDT) Q
+ ..S DGMTI=+DGMTI,DGMTYPT=1,DGMTACT="COM",DGMTROU="COM^DGMTEO" D EN^DGMTSC
+ .E  D WARNING
+ .Q
+ Q
+ ;
+WARNING ;
+ ;prints a warning to the screen about means test
+ ;
+ W !!,"A means test for this encounter date was not found and may be required!"
+ W !,"Further investigation will be needed."
+ W !
+ D PAUSE
+ Q
+ ;
+PAUSE ;
+ N DIR
+ S DIR(0)="FAO",DIR("A")="Press ENTER to continue " D ^DIR
+ Q
+ ;
+OKTOCONT(Y) ;
+ ;
+ N DIR
+ W !!,"Patient Requires a means Test"
+ X ^DD("DD")
+ W !,"Primary Means Test Required from '",Y,"'",!
+ ;
+ I $D(SDIEMM),'$D(^XUSEC("SCENI MEANS TEST EDIT",DUZ)) DO  G OKQ
+ .W !,$C(7),"You do not have the appropriate IEMM Security Key.  Contact your supervisor.",!
+ .D PAUSE
+ .S Y=0
+ ;
+ S DIR("A")="Do you wish to proceed with the means test at this time"
+ S DIR("B")="YES"
+ S DIR(0)="Y"
+ D ^DIR
+OKQ Q $S(Y=1:1,1:0)
+ ;
+CP ;If not (autoexempt or MTested) & no CP test this year then
+ ;prompt for add/edit cp test
+ N DIV,DGIB,DGIBDT,DGX,X,DIRUT,DTOUT
+ G:'$P($G(^DG(43,1,0)),U,41) QTCP ;USE CP FLAG
+ S DGIBDT=$S($D(DFN1):9999999-DFN1,1:DT)
+ D EN^DGMTCOR
+ I +$G(DGNOCOPF) S DGMTCOR=0
+ I DGMTCOR D THRESH^DGMTCOU1(DGIBDT) D EDT^DGMTCOU(DFN,DT)
+ K DGNOCOPF
+QTCP Q
