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,1015**;Aug 13, 1993;Build 21
START ;
EN D LO^DGUTL S DGCLPR=""
N DGDIV
S DGDIV=$$PRIM^VASITE
S:DGDIV %ZIS("B")=$P($G(^DG(40.8,+DGDIV,"DEV")),U,1)
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
K %ZIS("B")
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
;
;; ask to continue if patient died - DG*5.3*563 - pjr 10/12/04
S DOD="" I $G(DFN) S DOD=$P($G(^DPT(DFN,.35)),"^",1)
I DOD S Y=DOD,DGPME=0 D DIED^DGPMV I DGPME K DFN,DGRPOUT G A
;
D CIRN
;
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)
;
D ROMQRY
;
S (DGFC,CURR)=0
D:'$G(DGNEW) WARN S DA=DFN,DGFC="^1",VET=$S($D(^DPT(DFN,"VET")):^("VET")'="Y",1:0)
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
D HINQ^DG10
I $D(^DIC(195.4,1,"UP")) I ^("UP") D ADM^RTQ3
D REG^IVMCQ($G(DFN)) ; send financial query
G A1
;
RT I $D(^DIC(195.4,1,"UP")) I ^("UP") S $P(DGFC,U,1)=DIV D ADM^RTQ3
Q
;
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)
.I +$G(DGNEW) Q
.I $$ADD^DGADDUTL($G(DFN)) ;
G CH
PR W !!,"Is the patient currently being followed in a clinic for the same condition" S %=0 D YN^DICN G Q:%=-1
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
S CURR=% G SEEN
;
CK S DGEDCN=1 D ^DGRPC
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
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
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
ABIL D ^DGREGG
ENR ; next line appears to be dead code. left commented just to test. mli 4/28/94
;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)
REG S (DIE,DIC)="^DPT("_DFN_",""DIS"",",%DT="PTEX",%DT("A")="Registration login date/time: NOW// "
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
I (RESULT'="^") W " ("_RESULT(0)_")"
S DINUM=9999999-RESULT
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
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
;
;SAVE OFF DATE/TIME OF REGISTRATION FOR HL7 V2.3 MESSAGING, IN VAFCDDT
S VAFCDDT=X
;
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
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
.K DTOUT
.N DA,DIK
.S DA(1)=DFN,DA=DFN1,DIK="^DPT("_DFN_",""DIS"","
.D ^DIK
.W !!?5,"User Time-out. Required registration data could be missing."
.W !,?5,"This registration has been deleted."
; check whether facility applying to (division) is inactive
I '$$DIVCHK^DGREGFAC(DFN,DFN1) G CONT
ASKDIV W !!?5,"The facility chosen either has no pointer to an Institution"
W !?5,"file record or the Institution file record is inactive."
W !?5,"Please choose another division."
S DA=DFN1,DIE("NO^")="",DA(1)=DFN,DP=2.101,DR="3" D ^DIE
I $$DIVCHK^DGREGFAC(DFN,DFN1) G ASKDIV
CONT ; continue
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
S DA=DFN,DR="[DGREG]",DIE="^DPT(" D ^DIE K DIE("NO^")
I $D(^DPT(DFN,"DIS",DFN1,2)),$P(^(2),"^",1)="Y" S DIE="^DPT(",DR="[DG EMPLOYER]",DA=DFN D ^DIE
G ^DGREG0
PR2 W !!,"You can only enter new registrations through this option.",$C(7),$C(7) G REG
PR3 W !!,"Time is required to register the patient.",!!,$C(7),$C(7) G REG
H W !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue." G A1
Q K DG,DQ G Q1^DGREG0
Q1 K DGIO,DGASKDEV,DGFC,DGCLRP,CURR,DGELVER,DGNEW Q
EL S DR=DR_";13//" I $D(^DPT(DFN,.36)),$D(^DIC(8,+^(.36),0)) S DR=DR_$P(^(0),"^",1) Q
S DR=DR_"HUMANITARIAN EMERGENCY" Q
FEE S DGRPFEE=1 D DGREG K DGRPFEE G Q1
;
WARN I $S('$D(^DPT(DFN,.1)):0,$P(^(.1),"^",1)']"":0,1:1) W !,$C(7),"***PATIENT IS CURRENTLY AN INPATIENT***",! H 2
I $S('$D(^DPT(DFN,.107)):0,$P(^(.107),"^",1)']"":0,1:1) W !,$C(7),"***PATIENT IS CURRENTLY A LODGER***",! H 2
Q
MSG W !,"Another user is editing, try later ..." G Q
;
BEGINREG(DFN) ;
;Description: This is called at the beginning of the registration process.
;Concurrent processes can check the lock to determine if the patient is
;currently being registered.
;
Q:'$G(DFN) 0
I $$QRY^DGENQRY(DFN) W !!,"Enrollment/Eligibility Query sent ...",!!
L +^TMP(DFN,"REGISTRATION IN PROGRESS"):1
I $$LOCK^DGENPTA1(DFN) ;try to lock the patient record
Q
;
ENDREG(DFN) ;
;Description: releases the lock obtained by calling BEGINREG.
;
Q:'$G(DFN)
L -^TMP(DFN,"REGISTRATION IN PROGRESS")
D UNLOCK^DGENPTA1(DFN)
Q
;
IFREG(DFN) ;
;Description: tests whether the lock set by BEGINREG is set
;
;Input: DFN
;Output:
; Function Value = 1 if lock is set, 0 otherwise
;
N RETURN
Q:'$G(DFN) 0
L +^TMP(DFN,"REGISTRATION IN PROGRESS"):1
S RETURN='$T
L -^TMP(DFN,"REGISTRATION IN PROGRESS")
Q RETURN
Q
CIRN ;MPI QUERY
;check to see if CIRN PD/MPI is installed
N X S X="MPIFAPI" X ^%ZOSF("TEST") Q:'$T
K MPIFRTN
D MPIQ^MPIFAPI(DFN)
K MPIFRTN
Q
ROMQRY ;
I +$G(DGNEW) D
. ; query LST for Patient Demographic Information if NEW patient and
. ; file into patient's record.
. N A
. I $$ROMQRY^DGROAPI(DFN) D
. . ;display busy message to interactive users
. .S DGMSG(1)="Data retrieval from LST site has been completed successfully"
. .S DGMSG(2)="Thank you for your patience."
. .D EN^DDIOL(.DGMSG) R A:5
. E D
. . ;display busy message to interactive users
. .S DGMSG(1)="Data retrieval from LST site has not been successful."
. .S DGMSG(2)="Please continue the Registration Process."
. .D EN^DDIOL(.DGMSG) R A:5
. ;
Q
DGREG ;ALB/JDS,MRL/PJR/PHH-REGISTER PATIENT ; 8/24/05 1:40pm
+1 ;;5.3;Registration;**1,32,108,147,149,182,245,250,513,425,533,574,563,624,658,1015**;Aug 13, 1993;Build 21
START ;
EN DO LO^DGUTL
SET DGCLPR=""
+1 NEW DGDIV
+2 SET DGDIV=$$PRIM^VASITE
+3 IF DGDIV
SET %ZIS("B")=$PIECE($GET(^DG(40.8,+DGDIV,"DEV")),U,1)
+4 IF $PIECE(^DG(43,1,0),U,39)
SET %ZIS="NQ"
SET %ZIS("A")="Select 1010 printer: "
DO ^%ZIS
IF POP
QUIT
SET (DGIO(10),DGIO("PRF"),DGIO("RT"),DGIO("HS"))=ION
SET DGASKDEV=""
IF $EXTRACT(IOST,1,2)'["P-"
WRITE !,$CHAR(7),"Not a printer"
GOTO DGREG
+5 KILL %ZIS("B")
+6 IF '$DATA(DGIO)
IF $PIECE(^DG(43,1,0),U,30)
SET %ZIS="N"
SET IOP="HOME"
DO ^%ZIS
IF $DATA(IOS)
IF IOS
IF $DATA(^%ZIS(1,+IOS,99))
IF $DATA(^%ZIS(1,+^(99),0))
SET Y=$PIECE(^(0),U,1)
WRITE !,"Using closest printer ",Y,!
FOR I=10,"PRF","RT","HS"
SET DGIO(I)=Y
A DO ENDREG($GET(DFN))
+1 WRITE !!
SET DIC=2
SET DIC(0)="ALEQM"
SET DLAYGO=2
KILL DIC("S"),DIC("B")
DO ^DIC
KILL DLAYGO
IF Y<0
GOTO Q1
SET (DFN,DA)=+Y
SET DGNEW=$PIECE(Y,"^",3)
NEW Y
DO PAUSE^DG10
DO BEGINREG(DFN)
IF DGNEW
DO NEW^DGRP
+2 ;
+3 ;; ask to continue if patient died - DG*5.3*563 - pjr 10/12/04
+4 SET DOD=""
IF $GET(DFN)
SET DOD=$PIECE($GET(^DPT(DFN,.35)),"^",1)
+5 IF DOD
SET Y=DOD
SET DGPME=0
DO DIED^DGPMV
IF DGPME
KILL DFN,DGRPOUT
GOTO A
+6 ;
+7 DO CIRN
+8 ;
+9 IF +$GET(DGNEW)
Begin DoDot:1
+10 ; query CMOR for Patient Record Flag Assignments if NEW patient and
+11 ; display results.
+12 IF $$PRFQRY^DGPFAPI(DFN)
DO DISPPRF^DGPFAPI(DFN)
End DoDot:1
+13 ;
+14 DO ROMQRY
+15 ;
+16 SET (DGFC,CURR)=0
+17 IF '$GET(DGNEW)
DO WARN
SET DA=DFN
SET DGFC="^1"
SET VET=$SELECT($DATA(^DPT(DFN,"VET")):^("VET")'="Y",1:0)
+18 SET %ZIS="N"
SET IOP="HOME"
DO ^%ZIS
SET DGELVER=0
DO EN^DGRPD
IF $DATA(DGRPOUT)
DO ENDREG($GET(DFN))
DO HL7A08^VAFCDD01
KILL DFN,DGRPOUT
GOTO A
+19 DO HINQ^DG10
+20 IF $DATA(^DIC(195.4,1,"UP"))
IF ^("UP")
DO ADM^RTQ3
+21 ; send financial query
DO REG^IVMCQ($GET(DFN))
+22 GOTO A1
+23 ;
RT IF $DATA(^DIC(195.4,1,"UP"))
IF ^("UP")
SET $PIECE(DGFC,U,1)=DIV
DO ADM^RTQ3
+1 QUIT
+2 ;
A1 WRITE !,"Do you want to ",$SELECT(DGNEW:"enter",1:"edit")," Patient Data"
SET %=1
DO YN^DICN
Begin DoDot:1
+1 IF +$GET(DGNEW)
QUIT
+2 ;
IF $$ADD^DGADDUTL($GET(DFN))
End DoDot:1
IF '%
GOTO H
IF %'=1
GOTO CK
SET DGRPV=0
DO EN1^DGRP
IF '$DATA(DA)
GOTO Q
+3 GOTO CH
PR WRITE !!,"Is the patient currently being followed in a clinic for the same condition"
SET %=0
DO YN^DICN
IF %=-1
GOTO Q
+1 IF '%
WRITE !?4,$CHAR(7),"Enter 'Y' if the patient is being followed in clinic for condition for which",!?6,"registered, 'N' if not."
GOTO PR
+2 SET CURR=%
GOTO SEEN
+3 ;
CK SET DGEDCN=1
DO ^DGRPC
CH SET X=$SELECT('$DATA(^DPT(DFN,.36)):1,$PIECE(^(.36),"^",1)']"":1,1:0)
SET X1=$SELECT('$DATA(^DPT(DFN,.32)):1,$PIECE(^(.32),"^",3)']"":1,1:0)
IF 'X
IF 'X1
GOTO CH1
CH1 SET DA=DFN
IF '$DATA(^DPT("ADA",1,DA))
GOTO PR
WRITE !!,"There is still an open disposition--register aborted.",$CHAR(7),$CHAR(7)
GOTO Q
SEEN WRITE !!,"Is the patient to be examined in the medical center today"
SET %=1
DO YN^DICN
SET SEEN=%
IF %<0
GOTO Q
IF %'>0
WRITE !!,"Enter 'Y' if the patient is to be examined today, 'N' if not.",$CHAR(7)
GOTO SEEN
ABIL DO ^DGREGG
ENR ; next line appears to be dead code. left commented just to test. mli 4/28/94
+1 ;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)
REG SET (DIE,DIC)="^DPT("_DFN_",""DIS"","
SET %DT="PTEX"
SET %DT("A")="Registration login date/time: NOW// "
+1 WRITE !,%DT("A")
READ ANS:DTIME
IF '$TEST
SET ANS="^"
IF ANS=""
SET ANS="N"
SET X=ANS
IF ANS="^"
GOTO Q
SET DA(1)=DFN
DO CHK^DIE(2.101,.01,"E",X,.RESULT)
IF RESULT="^"!('$DATA(RESULT))
GOTO REG
IF '(RESULT#1)
GOTO PR3
SET Y=RESULT
+2 IF (RESULT'="^")
WRITE " ("_RESULT(0)_")"
+3 SET DINUM=9999999-RESULT
+4 SET (DFN1,Y1)=DINUM
SET APD=Y
IF $DATA(^DPT(DFN,"DIS",Y1))
WRITE !!,"You must enter a date that does not exist.",$CHAR(7),$CHAR(7)
GOTO REG
+5 IF $DATA(^DPT("ADA",1,DA))
GOTO CH1
LOCK @(DIE_DINUM_")"):2
IF '$TEST
GOTO MSG
IF '($DATA(^DPT(DA(1),"DIS",0))#2)
SET ^(0)="^2.101D^^"
SET DIC(0)="L"
SET X=+Y
DO ^DIC
+6 ;
+7 ;SAVE OFF DATE/TIME OF REGISTRATION FOR HL7 V2.3 MESSAGING, IN VAFCDDT
+8 SET VAFCDDT=X
+9 ;
+10 SET DA=DFN1
SET DIE("NO^")=""
SET DA(1)=DFN
SET DP=2.101
SET DR="1///"_$SELECT(SEEN=2:2,CURR=1:1,1:0)_";Q;2"_$SELECT(CURR=1:"///3",1:"")_";2.1;3//"_$SELECT($PIECE(^DG(43,1,"GL"),"^",2):"",1:"/")_$SELECT($DATA(^DG(40.8,+$PIECE(^DG(43,1,"GL"),"^",3),0)):$PIECE(^(0),"^",1),1:"")_";4////"_DUZ
+11 DO EL
KILL DIC("A")
NEW DGNDLOCK
SET DGNDLOCK=DIE_DFN1_")"
LOCK +@DGNDLOCK:2
IF '$TEST
GOTO MSG
DO ^DIE
LOCK -@DGNDLOCK
+12 IF $DATA(DTOUT)
Begin DoDot:1
+13 KILL DTOUT
+14 NEW DA,DIK
+15 SET DA(1)=DFN
SET DA=DFN1
SET DIK="^DPT("_DFN_",""DIS"","
+16 DO ^DIK
+17 WRITE !!?5,"User Time-out. Required registration data could be missing."
+18 WRITE !,?5,"This registration has been deleted."
End DoDot:1
GOTO Q
+19 ; check whether facility applying to (division) is inactive
+20 IF '$$DIVCHK^DGREGFAC(DFN,DFN1)
GOTO CONT
ASKDIV WRITE !!?5,"The facility chosen either has no pointer to an Institution"
+1 WRITE !?5,"file record or the Institution file record is inactive."
+2 WRITE !?5,"Please choose another division."
+3 SET DA=DFN1
SET DIE("NO^")=""
SET DA(1)=DFN
SET DP=2.101
SET DR="3"
DO ^DIE
+4 IF $$DIVCHK^DGREGFAC(DFN,DFN1)
GOTO ASKDIV
CONT ; continue
+1 SET DGXXXD=1
DO EL^DGREGE
IF $PIECE(^DPT(DFN,"DIS",DFN1,0),"^",3)=4
SET DA=DFN
SET DIE="^DPT("
SET DR=".368;.369"
DO ^DIE
SET DIE="^DPT("_DFN_",""DIS"","
SET DA(1)=DFN
SET DA=DFN1
+2 SET DA=DFN
SET DR="[DGREG]"
SET DIE="^DPT("
DO ^DIE
KILL DIE("NO^")
+3 IF $DATA(^DPT(DFN,"DIS",DFN1,2))
IF $PIECE(^(2),"^",1)="Y"
SET DIE="^DPT("
SET DR="[DG EMPLOYER]"
SET DA=DFN
DO ^DIE
+4 GOTO ^DGREG0
PR2 WRITE !!,"You can only enter new registrations through this option.",$CHAR(7),$CHAR(7)
GOTO REG
PR3 WRITE !!,"Time is required to register the patient.",!!,$CHAR(7),$CHAR(7)
GOTO REG
H WRITE !?5,"Enter 'YES' to enter/edit registration data or 'NO' to continue."
GOTO A1
Q KILL DG,DQ
GOTO Q1^DGREG0
Q1 KILL DGIO,DGASKDEV,DGFC,DGCLRP,CURR,DGELVER,DGNEW
QUIT
EL SET DR=DR_";13//"
IF $DATA(^DPT(DFN,.36))
IF $DATA(^DIC(8,+^(.36),0))
SET DR=DR_$PIECE(^(0),"^",1)
QUIT
+1 SET DR=DR_"HUMANITARIAN EMERGENCY"
QUIT
FEE SET DGRPFEE=1
DO DGREG
KILL DGRPFEE
GOTO Q1
+1 ;
WARN IF $SELECT('$DATA(^DPT(DFN,.1)):0,$PIECE(^(.1),"^",1)']"":0,1:1)
WRITE !,$CHAR(7),"***PATIENT IS CURRENTLY AN INPATIENT***",!
HANG 2
+1 IF $SELECT('$DATA(^DPT(DFN,.107)):0,$PIECE(^(.107),"^",1)']"":0,1:1)
WRITE !,$CHAR(7),"***PATIENT IS CURRENTLY A LODGER***",!
HANG 2
+2 QUIT
MSG WRITE !,"Another user is editing, try later ..."
GOTO Q
+1 ;
BEGINREG(DFN) ;
+1 ;Description: This is called at the beginning of the registration process.
+2 ;Concurrent processes can check the lock to determine if the patient is
+3 ;currently being registered.
+4 ;
+5 IF '$GET(DFN)
QUIT 0
+6 IF $$QRY^DGENQRY(DFN)
WRITE !!,"Enrollment/Eligibility Query sent ...",!!
+7 LOCK +^TMP(DFN,"REGISTRATION IN PROGRESS"):1
+8 ;try to lock the patient record
IF $$LOCK^DGENPTA1(DFN)
+9 QUIT
+10 ;
ENDREG(DFN) ;
+1 ;Description: releases the lock obtained by calling BEGINREG.
+2 ;
+3 IF '$GET(DFN)
QUIT
+4 LOCK -^TMP(DFN,"REGISTRATION IN PROGRESS")
+5 DO UNLOCK^DGENPTA1(DFN)
+6 QUIT
+7 ;
IFREG(DFN) ;
+1 ;Description: tests whether the lock set by BEGINREG is set
+2 ;
+3 ;Input: DFN
+4 ;Output:
+5 ; Function Value = 1 if lock is set, 0 otherwise
+6 ;
+7 NEW RETURN
+8 IF '$GET(DFN)
QUIT 0
+9 LOCK +^TMP(DFN,"REGISTRATION IN PROGRESS"):1
+10 SET RETURN='$TEST
+11 LOCK -^TMP(DFN,"REGISTRATION IN PROGRESS")
+12 QUIT RETURN
+13 QUIT
CIRN ;MPI QUERY
+1 ;check to see if CIRN PD/MPI is installed
+2 NEW X
SET X="MPIFAPI"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+3 KILL MPIFRTN
+4 DO MPIQ^MPIFAPI(DFN)
+5 KILL MPIFRTN
+6 QUIT
ROMQRY ;
+1 IF +$GET(DGNEW)
Begin DoDot:1
+2 ; query LST for Patient Demographic Information if NEW patient and
+3 ; file into patient's record.
+4 NEW A
+5 IF $$ROMQRY^DGROAPI(DFN)
Begin DoDot:2
+6 ;display busy message to interactive users
+7 SET DGMSG(1)="Data retrieval from LST site has been completed successfully"
+8 SET DGMSG(2)="Thank you for your patience."
+9 DO EN^DDIOL(.DGMSG)
READ A:5
End DoDot:2
+10 IF '$TEST
Begin DoDot:2
+11 ;display busy message to interactive users
+12 SET DGMSG(1)="Data retrieval from LST site has not been successful."
+13 SET DGMSG(2)="Please continue the Registration Process."
+14 DO EN^DDIOL(.DGMSG)
READ A:5
End DoDot:2
+15 ;
End DoDot:1
+16 QUIT
