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

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

@@ -1 @@
-DGRPD ;ALB/MRL/MLR/JAN/LBD/EG/BRM/JRC-PATIENT INQUIRY (NEW) ; 3/9/06 11:17am
- ;;5.3;Registration;**109,124,121,57,161,149,286,358,436,445,489,498,506,513,518,550,545,568,585,677,703**;Aug 13, 1993
+DGRPD ;ALB/MRL/MLR/JAN/LBD/EG/BRM/JRC-PATIENT INQUIRY (NEW) ;1/27/07  13:14
+ ;;5.3;Registration;**109,124,121,57,161,149,286,358,436,445,489,498,506,513,518,550,545,568,585,677,703,634**;Aug 13, 1993;Build 28
+ ; Modified from FOIA VISTA
+ ; GPL Copyright (C) 2007 WorldVistA
  ;  *286*  Newing variables X,Y in OKLINE subroutine
- ;  *358*  If a patient is on a domiciliary ward, don't display MEANS
- ;         TEST required/Medication Copayment Exemption messages
- ;  *436*  If an inpatient is not on a domiciliary ward, don't display
- ;         Medication Copayment Exemption message
- ;  *545*  Add death information near the remarks field
- ;  *677*  Added Emergency Response
+ ;  
 SEL K DFN,DGRPOUT W ! S DIC="^DPT(",DIC(0)="AEQMZ" D ^DIC G Q:Y'>0 S DFN=+Y N Y W ! S DIR(0)="E" D ^DIR G SEL:$D(DTOUT)!($D(DUOUT)) D EN G SEL
+ ;
 EN ;call to display patient inquiry - input DFN
  ;MPI/PD CHANGE
@@ -51 +49 @@
  .F X=2:1 Q:'$D(RACE(X,0))&'$D(ETHNIC(X,0))  W !,?9,$G(RACE(X,0)),?51,$G(ETHNIC(X,0))
  I '$$OKLINE(16) G Q
- ;display cv status #4156
- N DGCV S DGCV=$$CVEDT^DGCV(+DFN)
- W !!,?2,"Combat Vet Status: "_$S($P(DGCV,U,3)=1:"ELIGIBLE",$P(DGCV,U,3)="":"NOT ELIGIBLE",1:"EXPIRED") I DGCV>0 W ?45,"End Date: "_$$FMTE^XLFDT($P(DGCV,U,2),"5DZ")
+ ;
+ ; VOE change
+ ;
+ I DUZ("AG")="V" D
+ . ;display cv status #4156
+ . N DGCV S DGCV=$$CVEDT^DGCV(+DFN)
+ . W !!,?2,"Combat Vet Status: "_$S($P(DGCV,U,3)=1:"ELIGIBLE",$P(DGCV,U,3)="":"NOT ELIGIBLE",1:"EXPIRED") I DGCV>0 W ?45,"End Date: "_$$FMTE^XLFDT($P(DGCV,U,2),"5DZ")
+ ;
+ ; end VOE change
+ ;
  ;display primary eligibility
  S X1=DGRP(.36),X=$P(DGRP(.361),"^",1) W !,"Primary Eligibility: ",$S($D(^DIC(8,+X1,0)):$P(^(0),"^",1)_" ("_$S(X="V":"VERIFIED",X="P":"PENDING VERIFICATION",X="R":"PENDING REVERIFICATION",1:"NOT VERIFIED")_")",1:DGRPU)
@@ -111 +116 @@
 HDR I '$D(IOF) S IOP="HOME" D ^%ZIS K IOP
  ;MPI/PD CHANGE
- W @IOF,!,$P(VADM(1),"^",1),?40,$P(VADM(2),"^",2),?65,$P(VADM(3),"^",2) S X="",$P(X,"=",78)="" W !,X,!?15,"COORDINATING MASTER OF RECORD: ",DGCMOR,! Q
+ ; VOE CHANGE
+ ; W @IOF,!,$P(VADM(1),"^",1),?40,$P(VADM(2),"^",2),?65,$P(VADM(3),"^",2) S X="",$P(X,"=",78)="" W !,X,!?15,"COORDINATING MASTER OF RECORD: ",DGCMOR,! Q
+ W @IOF,!,$P(VADM(1),"^",1),?32,$P(VADM(2),"^",2),?50,$$HRNV(DFN),?65,$P(VADM(3),"^",2) S X="",$P(X,"=",78)="" W !,X,!?15,"COORDINATING MASTER OF RECORD: ",DGCMOR,! Q
  ;END MPI/PD CHANGE
+HRNV(DFN) ;
+ N IRET
+ S IRET=$$HRN^DGLBPID(DFN)
+ I IRET="#" Q ""
+ S IRET="HRN "_IRET
+ Q IRET
+ ; END VOE CHANGE
+ ;
 INP S VAIP("D")="L" D INP^DGPMV10
  S DGPMT=0