| 1 | DG10 ;ALB/MRL,DAK,AEG,PHH-LOAD/EDIT PATIENT DATA ; 1/5/2006 21:46
|
|---|
| 2 | ;;5.3;Registration;**32,109,139,149,182,326,513,425,574,642,658,634**;Aug 13, 1993;Build 30
|
|---|
| 3 | ; Modified from FOIA VISTA,
|
|---|
| 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
|
|---|
| 19 | START ;
|
|---|
| 20 | D LO^DGUTL
|
|---|
| 21 | I $G(DGPRFLG)=1,$G(DGPLOC)=1 D G Q:$G(DGRPOUT),A1
|
|---|
| 22 | .; D EN^DGRPD,REG^IVMCQ($G(DFN))
|
|---|
| 23 | . D EN^DGRPD
|
|---|
| 24 | . Q:$G(DGRPOUT)
|
|---|
| 25 | . ;
|
|---|
| 26 | . ; ** start of VOE change 1 of 3: DAOU/WCJ,VA/CJS,WV/TOAD 1/5/2006 **
|
|---|
| 27 | . ;
|
|---|
| 28 | . ; HEC query call only wanted/needed for VA agency code
|
|---|
| 29 | . ;
|
|---|
| 30 | . I $G(DUZ("AG"))="V" D REG^IVMCQ($G(DFN))
|
|---|
| 31 | . ;
|
|---|
| 32 | . ; ** end of VOE change 1 **
|
|---|
| 33 | . ;
|
|---|
| 34 | . D HINQ
|
|---|
| 35 | ;
|
|---|
| 36 | 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
|
|---|
| 37 | N Y D PAUSE I DGNEW D NEW^DGRP S DA=DFN,VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0)
|
|---|
| 38 | ;
|
|---|
| 39 | ;MPI QUERY
|
|---|
| 40 | ;check to see if CIRN PD/MPI is installed
|
|---|
| 41 | N X S X="MPIFAPI" X ^%ZOSF("TEST") G:'$T SKIP
|
|---|
| 42 | K MPIFRTN
|
|---|
| 43 | ;
|
|---|
| 44 | ; ** start of VOE change 2 of 3: DAOU/WCJ,VA/CJS,WV/TOAD 1/5/2006 **
|
|---|
| 45 | ;
|
|---|
| 46 | ; MPI query call only wanted/needed for VA agency code
|
|---|
| 47 | ;
|
|---|
| 48 | I $G(DUZ("AG"))="V"!$$GET^XPAR("SYS","DG MPI") D MPIQ^MPIFAPI(DFN)
|
|---|
| 49 | ;
|
|---|
| 50 | ; ** end of VOE change 2 **
|
|---|
| 51 | ;
|
|---|
| 52 | K MPIFRTN
|
|---|
| 53 | ;
|
|---|
| 54 | I +$G(DGNEW) D
|
|---|
| 55 | . ; query CMOR for Patient Record Flag Assignments if NEW patient and
|
|---|
| 56 | . ; display results
|
|---|
| 57 | . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN)
|
|---|
| 58 | ;
|
|---|
| 59 | SKIP ;
|
|---|
| 60 | S DGELVER=0 D EN^DGRPD I $D(DGRPOUT) K DGRPOUT G A
|
|---|
| 61 | ;
|
|---|
| 62 | ; ** start of VOE change 3 of 3: DAOU/WCJ,VA/CJS,WV/TOAD 1/5/2006 **
|
|---|
| 63 | ;
|
|---|
| 64 | ; these query calls only wanted/needed for VA agency code
|
|---|
| 65 | ;
|
|---|
| 66 | I $G(DUZ("AG"))="V" D HINQ,REG^IVMCQ($G(DFN))
|
|---|
| 67 | G A1
|
|---|
| 68 | ;
|
|---|
| 69 | ; ** end of VOE change 3 **
|
|---|
| 70 | ;
|
|---|
| 71 | ;
|
|---|
| 72 | HINQ ;
|
|---|
| 73 | 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
|
|---|
| 74 | .N DGROUT
|
|---|
| 75 | .S DGROUT=X
|
|---|
| 76 | .I $G(DFN) D
|
|---|
| 77 | ..N X,Y,DGRP
|
|---|
| 78 | ..F X=.3,.32 S DGRP(X)=$G(^DPT(DFN,X))
|
|---|
| 79 | ..W !," Money Verified: " S Y=$P(DGRP(.3),"^",6) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")
|
|---|
| 80 | ..W ?40," Service Verified: " S Y=$P(DGRP(.32),"^",2) X:Y]"" ^DD("DD") W $S(Y]"":Y,1:"NOT VERIFIED")
|
|---|
| 81 | .D @("EN^"_DGROUT) K Y Q ;from dgdem0
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | ; SDIEMM is used as a flag by AMBCARE Incomplete Encounter Management
|
|---|
| 85 | ; to bypass the embossing routines when calling load/edit from IEMM
|
|---|
| 86 | ;
|
|---|
| 87 | 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
|
|---|
| 88 | .W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data"
|
|---|
| 89 | .S %=1 D YN^DICN
|
|---|
| 90 | .I +$G(DGNEW) Q
|
|---|
| 91 | .I $$ADD^DGADDUTL($G(DFN)) ;
|
|---|
| 92 | ;
|
|---|
| 93 | H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue without",!?5,"editing."
|
|---|
| 94 | G A1
|
|---|
| 95 | ;
|
|---|
| 96 | CK S DGEDCN=1 D ^DGRPC,MT(DFN),CP
|
|---|
| 97 | G Q:$G(DGPRFLG)=1 G Q:$G(SDIEMM)
|
|---|
| 98 | 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
|
|---|
| 99 | ;G:Y ^DGRP9
|
|---|
| 100 | ;
|
|---|
| 101 | EMBOS ;W ! D EMBOS^DGQEMA G A
|
|---|
| 102 | G A
|
|---|
| 103 | ;
|
|---|
| 104 | ;
|
|---|
| 105 | Q K X,Y,Z,DIC,DGELVER,DGNEW,DGRPV,VET Q
|
|---|
| 106 | ;
|
|---|
| 107 | MT(DFN) ; Check if user requires a means test. Ask user if they want to proceedif
|
|---|
| 108 | ; one is required
|
|---|
| 109 | I '$D(SDIEMM) DO
|
|---|
| 110 | .N DGREQF,DIV
|
|---|
| 111 | .D EN^DGMTR
|
|---|
| 112 | .I DGREQF D EDT^DGMTU(DFN,DT):$P($$MTS^DGMTU(DFN),U,2)="R"
|
|---|
| 113 | .Q
|
|---|
| 114 | I $D(SDIEMM) DO
|
|---|
| 115 | .N DGMTI
|
|---|
| 116 | .S DGMTI=$$LST^DGMTU(DFN,SCINF("ENCOUNTER"),1)
|
|---|
| 117 | .I $P(DGMTI,U,4)="R" D I 1
|
|---|
| 118 | ..S DGMT0=$G(^DGMT(408.31,+DGMTI,0)),DGMTDT=$P(DGMT0,"^")
|
|---|
| 119 | ..I '$$OKTOCONT(DGMTDT) Q
|
|---|
| 120 | ..S DGMTI=+DGMTI,DGMTYPT=1,DGMTACT="COM",DGMTROU="COM^DGMTEO" D EN^DGMTSC
|
|---|
| 121 | .E D WARNING
|
|---|
| 122 | .Q
|
|---|
| 123 | Q
|
|---|
| 124 | ;
|
|---|
| 125 | WARNING ;
|
|---|
| 126 | ;prints a warning to the screen about means test
|
|---|
| 127 | ;
|
|---|
| 128 | W !!,"A means test for this encounter date was not found and may be required!"
|
|---|
| 129 | W !,"Further investigation will be needed."
|
|---|
| 130 | W !
|
|---|
| 131 | D PAUSE
|
|---|
| 132 | Q
|
|---|
| 133 | ;
|
|---|
| 134 | PAUSE ;
|
|---|
| 135 | N DIR
|
|---|
| 136 | S DIR(0)="FAO",DIR("A")="Press ENTER to continue " D ^DIR
|
|---|
| 137 | Q
|
|---|
| 138 | ;
|
|---|
| 139 | OKTOCONT(Y) ;
|
|---|
| 140 | ;
|
|---|
| 141 | N DIR
|
|---|
| 142 | W !!,"Patient Requires a means Test"
|
|---|
| 143 | X ^DD("DD")
|
|---|
| 144 | W !,"Primary Means Test Required from '",Y,"'",!
|
|---|
| 145 | ;
|
|---|
| 146 | I $D(SDIEMM),'$D(^XUSEC("SCENI MEANS TEST EDIT",DUZ)) DO G OKQ
|
|---|
| 147 | .W !,$C(7),"You do not have the appropriate IEMM Security Key. Contact your supervisor.",!
|
|---|
| 148 | .D PAUSE
|
|---|
| 149 | .S Y=0
|
|---|
| 150 | ;
|
|---|
| 151 | S DIR("A")="Do you wish to proceed with the means test at this time"
|
|---|
| 152 | S DIR("B")="YES"
|
|---|
| 153 | S DIR(0)="Y"
|
|---|
| 154 | D ^DIR
|
|---|
| 155 | OKQ Q $S(Y=1:1,1:0)
|
|---|
| 156 | ;
|
|---|
| 157 | CP ;If not (autoexempt or MTested) & no CP test this year then
|
|---|
| 158 | ;prompt for add/edit cp test
|
|---|
| 159 | N DIV,DGIB,DGIBDT,DGX,X,DIRUT,DTOUT
|
|---|
| 160 | G:'$P($G(^DG(43,1,0)),U,41) QTCP ;USE CP FLAG
|
|---|
| 161 | S DGIBDT=$S($D(DFN1):9999999-DFN1,1:DT)
|
|---|
| 162 | D EN^DGMTCOR
|
|---|
| 163 | I +$G(DGNOCOPF) S DGMTCOR=0
|
|---|
| 164 | I DGMTCOR D THRESH^DGMTCOU1(DGIBDT) D EDT^DGMTCOU(DFN,DT)
|
|---|
| 165 | K DGNOCOPF
|
|---|
| 166 | QTCP Q
|
|---|
