| [613] | 1 | DGREG ;ALB/JDS,MRL/PJR/PHH-REGISTER PATIENT ;1/27/07 13:08
|
|---|
| 2 | ;;5.3;Registration;**1,32,108,147,149,182,245,250,513,425,533,574,563,624,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 | START ;
|
|---|
| 12 | EN D LO^DGUTL S DGCLPR=""
|
|---|
| 13 | N DGDIV
|
|---|
| 14 | S DGDIV=$$PRIM^VASITE
|
|---|
| 15 | S:DGDIV %ZIS("B")=$P($G(^DG(40.8,+DGDIV,"DEV")),U,1)
|
|---|
| 16 | I $P(^DG(43,1,0),U,39) S %ZIS="NQ",%ZIS("A")="Select 1010 printer: " D ^%ZIS Q:POP S (DGIO(10),DGIO("PRF"),DGIO("RT"),DGIO("HS"))=ION,DGASKDEV="" I $E(IOST,1,2)'["P-" W !,$C(7),"Not a printer" G DGREG
|
|---|
| 17 | K %ZIS("B")
|
|---|
| 18 | 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
|
|---|
| 19 | A D ENDREG($G(DFN))
|
|---|
| 20 | ;
|
|---|
| 21 | ; ** VOE change 1 of 4: DAOU/WCJ 2/1/2005,VA/CJS,WV/TOAD 1/5/2006 **
|
|---|
| 22 | ;
|
|---|
| 23 | ; if not VA agency code, add DIC("DR") to default some identifiers and
|
|---|
| 24 | ; skip others also, improve readability
|
|---|
| 25 | ;
|
|---|
| 26 | ; before change:
|
|---|
| 27 | ; 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
|
|---|
| 28 | ;
|
|---|
| 29 | ; after change:
|
|---|
| 30 | W !!
|
|---|
| 31 | N Y,DGREGY S DGREGY=1 D I DGREGY<0 G Q1
|
|---|
| 32 | . N DIC S DIC=2 ; Patient file
|
|---|
| 33 | . S DIC(0)="ALEQM" ; ask, laygo, echo, question, and multi-index
|
|---|
| 34 | . N DLAYGO S DLAYGO=2 ; override file access by user: allow laygo
|
|---|
| 35 | . I $G(DUZ("AG"))'="V" D ;adjust identifiers asked for VOE
|
|---|
| 36 | . . S DIC("DR")=".02;.03;994;.301///N;391///VISTA OFFICE EHR;1901///N;.09"
|
|---|
| 37 | . ;
|
|---|
| 38 | . D ^DIC ; Select Patient
|
|---|
| 39 | . ;
|
|---|
| 40 | . I Y<0 S DGREGY=-1 Q
|
|---|
| 41 | . K DIC("DR")
|
|---|
| 42 | . S (DFN,DA)=+Y
|
|---|
| 43 | . S DGNEW=$P(Y,"^",3) ; new patient?
|
|---|
| 44 | . N Y D PAUSE^DG10 ; prompt user before continuing
|
|---|
| 45 | . D BEGINREG(DFN) ; lock patient record
|
|---|
| 46 | ;
|
|---|
| 47 | ; ** end of VOE change 1 **
|
|---|
| 48 | ;
|
|---|
| 49 | ;; ask to continue if patient died - DG*5.3*563 - pjr 10/12/04
|
|---|
| 50 | S DOD="" I $G(DFN) S DOD=$P($G(^DPT(DFN,.35)),"^",1)
|
|---|
| 51 | I DOD S Y=DOD,DGPME=0 D DIED^DGPMV I DGPME K DFN,DGRPOUT G A
|
|---|
| 52 | ;
|
|---|
| 53 | D CIRN
|
|---|
| 54 | ;
|
|---|
| 55 | ; ** VOE change 2 of 4: DAOU/WCJ 2/1/2005,VA/CJS,WV/TOAD 1/5/2006 **
|
|---|
| 56 | ;
|
|---|
| 57 | I $G(DGNEW) D NEW^DGRP ; execute new patient DR string
|
|---|
| 58 | ;
|
|---|
| 59 | ; send CMOR query and display results only if VA agency code
|
|---|
| 60 | ;
|
|---|
| 61 | ; before change:
|
|---|
| 62 | ; I +$G(DGNEW) D
|
|---|
| 63 | ;
|
|---|
| 64 | ; after change:
|
|---|
| 65 | I $G(DGNEW),$G(DUZ("AG"))="V" D
|
|---|
| 66 | . ;
|
|---|
| 67 | . ; end of change
|
|---|
| 68 | . ;
|
|---|
| 69 | . ; query CMOR for Patient Record Flag Assignments if NEW patient and
|
|---|
| 70 | . ; display results.
|
|---|
| 71 | . I $$PRFQRY^DGPFAPI(DFN) D DISPPRF^DGPFAPI(DFN)
|
|---|
| 72 | ;
|
|---|
| 73 | ; before change:
|
|---|
| 74 | ; D ROMQRY
|
|---|
| 75 | ;
|
|---|
| 76 | ; after change:
|
|---|
| 77 | I $G(DUZ("AG"))="V" D ROMQRY
|
|---|
| 78 | ;
|
|---|
| 79 | ; ** end of VOE change 2 **
|
|---|
| 80 | ;
|
|---|
| 81 | S (DGFC,CURR)=0
|
|---|
| 82 | D:'$G(DGNEW) WARN S DA=DFN,DGFC="^1",VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0)
|
|---|
| 83 | S %ZIS="N",IOP="HOME" D ^%ZIS S DGELVER=0 D EN^DGRPD I $D(DGRPOUT) D ENDREG($G(DFN)) D HL7A08^VAFCDD01 K DFN,DGRPOUT G A
|
|---|
| 84 | D HINQ^DG10
|
|---|
| 85 | I $D(^DIC(195.4,1,"UP")) I ^("UP") D ADM^RTQ3
|
|---|
| 86 | ;
|
|---|
| 87 | ; ** VOE change 3 of 4: DAOU/WCJ 2/1/2005,VA/CJS,WV/TOAD 1/5/2006 **
|
|---|
| 88 | ;
|
|---|
| 89 | ; send financial query only for VA agency code
|
|---|
| 90 | ;
|
|---|
| 91 | ; before change:
|
|---|
| 92 | ; D REG^IVMCQ($G(DFN)) ; send financial query
|
|---|
| 93 | ;
|
|---|
| 94 | ; after change:
|
|---|
| 95 | I $G(DUZ("AG"))="V" D REG^IVMCQ($G(DFN)) ; send financial query
|
|---|
| 96 | ;
|
|---|
| 97 | ; ** end of VOE change 3 **
|
|---|
| 98 | ;
|
|---|
| 99 | G A1
|
|---|
| 100 | ;
|
|---|
| 101 | RT I $D(^DIC(195.4,1,"UP")) I ^("UP") S $P(DGFC,U,1)=DIV D ADM^RTQ3
|
|---|
| 102 | Q
|
|---|
| 103 | ;
|
|---|
| 104 | A1 W !,"Do you want to ",$S(DGNEW:"enter",1:"edit")," Patient Data" S %=1 D YN^DICN D G H:'%,CK:%'=1 S DGRPV=0 D EN1^DGRP G Q:'$D(DA)
|
|---|
| 105 | .I +$G(DGNEW) Q
|
|---|
| 106 | .I $$ADD^DGADDUTL($G(DFN)) ;
|
|---|
| 107 | G CH
|
|---|
| 108 | PR W !!,"Is the patient currently being followed in a clinic for the same condition" S %=0 D YN^DICN G Q:%=-1
|
|---|
| 109 | I '% W !?4,$C(7),"Enter 'Y' if the patient is being followed in clinic for condition for which",!?6,"registered, 'N' if not." G PR
|
|---|
| 110 | S CURR=% G SEEN
|
|---|
| 111 | ;
|
|---|
| 112 | CK S DGEDCN=1 D ^DGRPC
|
|---|
| 113 | CH S X=$S('$D(^DPT(DFN,.36)):1,$P(^(.36),"^",1)']"":1,1:0),X1=$S('$D(^DPT(DFN,.32)):1,$P(^(.32),"^",3)']"":1,1:0) I 'X,'X1 G CH1
|
|---|
| 114 | CH1 S DA=DFN G PR:'$D(^DPT("ADA",1,DA)) W !!,"There is still an open disposition--register aborted.",$C(7),$C(7) G Q
|
|---|
| 115 | SEEN W !!,"Is the patient to be examined in the medical center today" S %=1 D YN^DICN S SEEN=% G:%<0 Q I %'>0 W !!,"Enter 'Y' if the patient is to be examined today, 'N' if not.",$C(7) G SEEN
|
|---|
| 116 | ABIL D ^DGREGG
|
|---|
| 117 | ENR ; next line appears to be dead code. left commented just to test. mli 4/28/94
|
|---|
| 118 | ;S DE=0 F I=0:0 S I=$O(^DPT(DA,"DE",I)) Q:'I I $P(^(I,0),"^",3)'?7N Q D PR:'DE S L=+$P($S($D(^SC(L,0)):^(0),1:""),"^",1)
|
|---|
| 119 | REG S (DIE,DIC)="^DPT("_DFN_",""DIS"",",%DT="PTEX",%DT("A")="Registration login date/time: NOW// "
|
|---|
| 120 | W !,%DT("A") R ANS:DTIME S:'$T ANS="^" S:ANS="" ANS="N" S X=ANS G Q:ANS="^" S DA(1)=DFN D CHK^DIE(2.101,.01,"E",X,.RESULT) G REG:RESULT="^"!('$D(RESULT)),PR3:'(RESULT#1) S Y=RESULT
|
|---|
| 121 | I (RESULT'="^") W " ("_RESULT(0)_")"
|
|---|
| 122 | S DINUM=9999999-RESULT
|
|---|
| 123 | S (DFN1,Y1)=DINUM,APD=Y I $D(^DPT(DFN,"DIS",Y1)) W !!,"You must enter a date that does not exist.",$C(7),$C(7) G REG
|
|---|
| 124 | G:$D(^DPT("ADA",1,DA)) CH1 L @(DIE_DINUM_")"):2 G:'$T MSG S:'($D(^DPT(DA(1),"DIS",0))#2) ^(0)="^2.101D^^" S DIC(0)="L",X=+Y D ^DIC
|
|---|
| 125 | ;
|
|---|
| 126 | ;SAVE OFF DATE/TIME OF REGISTRATION FOR HL7 V2.3 MESSAGING, IN VAFCDDT
|
|---|
| 127 | S VAFCDDT=X
|
|---|
| 128 | ;
|
|---|
| 129 | 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
|
|---|
| 130 | ;
|
|---|
| 131 | ; ** VOE change 4 of 4: DAOU/JLG 2/7/2005,VA/CJS,WV/TOAD 1/5/2006 **
|
|---|
| 132 | ;
|
|---|
| 133 | ; for VOE or IHS agency codes, add the following:
|
|---|
| 134 | ; force TYPE OF CARE with ALL OTHER
|
|---|
| 135 | ;
|
|---|
| 136 | I $G(DUZ("AG"))="E"!($G(DUZ("AG"))="I") D
|
|---|
| 137 | . 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
|
|---|
| 138 | ;
|
|---|
| 139 | ; ** end of VOE change 4 **
|
|---|
| 140 | ;
|
|---|
| 141 | D EL K DIC("A") N DGNDLOCK S DGNDLOCK=DIE_DFN1_")" L +@DGNDLOCK:2 G:'$T MSG D ^DIE L -@DGNDLOCK
|
|---|
| 142 | I $D(DTOUT) D G Q
|
|---|
| 143 | .K DTOUT
|
|---|
| 144 | .N DA,DIK
|
|---|
| 145 | .S DA(1)=DFN,DA=DFN1,DIK="^DPT("_DFN_",""DIS"","
|
|---|
| 146 | .D ^DIK
|
|---|
| 147 | .W !!?5,"User Time-out. Required registration data could be missing."
|
|---|
| 148 | .W !,?5,"This registration has been deleted."
|
|---|
| 149 | ; check whether facility applying to (division) is inactive
|
|---|
| 150 | I '$$DIVCHK^DGREGFAC(DFN,DFN1) G CONT
|
|---|
| 151 | ASKDIV W !!?5,"The facility chosen either has no pointer to an Institution"
|
|---|
| 152 | W !?5,"file record or the Institution file record is inactive."
|
|---|
| 153 | W !?5,"Please choose another division."
|
|---|
| 154 | S DA=DFN1,DIE("NO^")="",DA(1)=DFN,DP=2.101,DR="3" D ^DIE
|
|---|
| 155 | I $$DIVCHK^DGREGFAC(DFN,DFN1) G ASKDIV
|
|---|
| 156 | CONT ; continue
|
|---|
| 157 | S DGXXXD=1 D EL^DGREGE I $P(^DPT(DFN,"DIS",DFN1,0),"^",3)=4 S DA=DFN,DIE="^DPT(",DR=".368;.369" D ^DIE S DIE="^DPT("_DFN_",""DIS"",",DA(1)=DFN,DA=DFN1
|
|---|
| 158 | S DA=DFN,DR="[DGREG]",DIE="^DPT(" D ^DIE K DIE("NO^")
|
|---|
| 159 | I $D(^DPT(DFN,"DIS",DFN1,2)),$P(^(2),"^",1)="Y" S DIE="^DPT(",DR="[DG EMPLOYER]",DA=DFN D ^DIE
|
|---|
| 160 | G ^DGREG0
|
|---|
| 161 | PR2 W !!,"You can only enter new registrations through this option.",$C(7),$C(7) G REG
|
|---|
| 162 | PR3 W !!,"Time is required to register the patient.",!!,$C(7),$C(7) G REG
|
|---|
| 163 | H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue." G A1
|
|---|
| 164 | Q K DG,DQ G Q1^DGREG0
|
|---|
| 165 | Q1 K DGIO,DGASKDEV,DGFC,DGCLRP,CURR,DGELVER,DGNEW Q
|
|---|
| 166 | EL S DR=DR_";13//" I $D(^DPT(DFN,.36)),$D(^DIC(8,+^(.36),0)) S DR=DR_$P(^(0),"^",1) Q
|
|---|
| 167 | S DR=DR_"HUMANITARIAN EMERGENCY" Q
|
|---|
| 168 | FEE S DGRPFEE=1 D DGREG K DGRPFEE G Q1
|
|---|
| 169 | ;
|
|---|
| 170 | WARN I $S('$D(^DPT(DFN,.1)):0,$P(^(.1),"^",1)']"":0,1:1) W !,$C(7),"***PATIENT IS CURRENTLY AN INPATIENT***",! H 2
|
|---|
| 171 | I $S('$D(^DPT(DFN,.107)):0,$P(^(.107),"^",1)']"":0,1:1) W !,$C(7),"***PATIENT IS CURRENTLY A LODGER***",! H 2
|
|---|
| 172 | Q
|
|---|
| 173 | MSG W !,"Another user is editing, try later ..." G Q
|
|---|
| 174 | ;
|
|---|
| 175 | BEGINREG(DFN) ;
|
|---|
| 176 | ;Description: This is called at the beginning of the registration process.
|
|---|
| 177 | ;Concurrent processes can check the lock to determine if the patient is
|
|---|
| 178 | ;currently being registered.
|
|---|
| 179 | ;
|
|---|
| 180 | Q:'$G(DFN) 0
|
|---|
| 181 | I $$QRY^DGENQRY(DFN) W !!,"Enrollment/Eligibility Query sent ...",!!
|
|---|
| 182 | L +^TMP(DFN,"REGISTRATION IN PROGRESS"):1
|
|---|
| 183 | I $$LOCK^DGENPTA1(DFN) ;try to lock the patient record
|
|---|
| 184 | Q
|
|---|
| 185 | ;
|
|---|
| 186 | ENDREG(DFN) ;
|
|---|
| 187 | ;Description: releases the lock obtained by calling BEGINREG.
|
|---|
| 188 | ;
|
|---|
| 189 | Q:'$G(DFN)
|
|---|
| 190 | L -^TMP(DFN,"REGISTRATION IN PROGRESS")
|
|---|
| 191 | D UNLOCK^DGENPTA1(DFN)
|
|---|
| 192 | Q
|
|---|
| 193 | ;
|
|---|
| 194 | IFREG(DFN) ;
|
|---|
| 195 | ;Description: tests whether the lock set by BEGINREG is set
|
|---|
| 196 | ;
|
|---|
| 197 | ;Input: DFN
|
|---|
| 198 | ;Output:
|
|---|
| 199 | ; Function Value = 1 if lock is set, 0 otherwise
|
|---|
| 200 | ;
|
|---|
| 201 | N RETURN
|
|---|
| 202 | Q:'$G(DFN) 0
|
|---|
| 203 | L +^TMP(DFN,"REGISTRATION IN PROGRESS"):1
|
|---|
| 204 | S RETURN='$T
|
|---|
| 205 | L -^TMP(DFN,"REGISTRATION IN PROGRESS")
|
|---|
| 206 | Q RETURN
|
|---|
| 207 | Q
|
|---|
| 208 | CIRN ;MPI QUERY
|
|---|
| 209 | ;check to see if CIRN PD/MPI is installed
|
|---|
| 210 | N X S X="MPIFAPI" X ^%ZOSF("TEST") Q:'$T
|
|---|
| 211 | K MPIFRTN
|
|---|
| 212 | D MPIQ^MPIFAPI(DFN)
|
|---|
| 213 | K MPIFRTN
|
|---|
| 214 | Q
|
|---|
| 215 | ROMQRY ;
|
|---|
| 216 | I +$G(DGNEW) D
|
|---|
| 217 | . ; query LST for Patient Demographic Information if NEW patient and
|
|---|
| 218 | . ; file into patient's record.
|
|---|
| 219 | . N A
|
|---|
| 220 | . I $$ROMQRY^DGROAPI(DFN) D
|
|---|
| 221 | . . ;display busy message to interactive users
|
|---|
| 222 | . .S DGMSG(1)="Data retrieval from LST site has been completed successfully"
|
|---|
| 223 | . .S DGMSG(2)="Thank you for your patience."
|
|---|
| 224 | . .D EN^DDIOL(.DGMSG) R A:5
|
|---|
| 225 | . E D
|
|---|
| 226 | . . ;display busy message to interactive users
|
|---|
| 227 | . .S DGMSG(1)="Data retrieval from LST site has not been successful."
|
|---|
| 228 | . .S DGMSG(2)="Please continue the Registration Process."
|
|---|
| 229 | . .D EN^DDIOL(.DGMSG) R A:5
|
|---|
| 230 | . ;
|
|---|
| 231 | Q
|
|---|
