BIVISIT1 ;IHS/CMI/MWR - CREATE/EDIT VISITS.; MAY 10, 2010
;;8.5;IMMUNIZATION;**5**;JUL 01,2013
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; CODE TO CREATE OR EDIT VISITS FOR IMMUNIZATIONS AND SKIN TESTS.
;; PATCH 1: Allow for negative values of Y (time difference). CREATE+91
;; Correct "Other" Location not getting set during edits. VISIT+14
;; PATCH 5: Added BINOM parameter to ADDEDIT P.E.P. for Visit Selection Menu.
;; VISIT+0
;
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
;----------
VISIT(BIDFN,BIDATE,BICAT,BILOC,BIOLOC,BISITE,BIVSIT,BIERR,BINOM) ;EP
;---> Create or edit a Visit for this patient's Immunization or
;---> Skin Test. Called by BIVISIT.
;---> Parameters:
; 1 - BIDFN (req) DFN of patient.
; 2 - BIDATE (req) Date.Time of Visit.
; 3 - BILOC (req) Location of encounter IEN.
; 4 - BIOLOC (opt) Other Location of encounter.
; 5 - BICAT (req) Category: A (Ambul), I (Inpat), E (Event/Hist)
; 6 - BISITE (req) DUZ(2) for Site Parameters.
; 7 - BIVSIT (ret) IEN of Visit (may exist already or be new).
; 8 - BIERR (ret) Text of Error Code if any, otherwise null.
; 9 - BINOM (opt) 0=Allow display of Visit Selection Menu if site
; parameter is set. 1=No display (for export).
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
S:($G(BINOM)="") BINOM=0
;
;---> First, determine Location.
;---> If BILOC<1 or if Outside Location is not null set BILOC equal
;---> to "OTHER" entry in Location File by checking BI SITE Parameter.
S:('$G(BILOC)!($G(BIOLOC)]"")) BILOC=$$OTHERLOC^BIUTL6(DUZ(2))
;
;---> Quit if "OTHER" Location has not been selected in Site Parameters.
I 'BILOC S BIERR="1^"_$$OTHERLOC^BIUTL6(DUZ(2),1) Q
;
;---> Create Visit if necessary.
;
;---> If no Parent Visit EIN, create a new Visit.
I '$G(BIVSIT) D CREATE(.BIVSIT,.BIERR,BINOM) Q
;
;---> If Parent Visit doesn't really exist, create a new Visit.
I '$G(^AUPNVSIT(+BIVSIT,0)) D CREATE(.BIVSIT,.BIERR,BINOM) Q
;
;---> If edit of old VISIT changed Date.Time, create a new Visit.
I $P(^AUPNVSIT(+BIVSIT,0),U)'=BIDATE D CREATE(.BIVSIT,.BIERR,BINOM) Q
;
;---> If edit of old VISIT changed Category, create a new Visit.
I $P(^AUPNVSIT(+BIVSIT,0),U,7)'=BICAT D CREATE(.BIVSIT,.BIERR,BINOM) Q
;
;
;---> If Outside Location was deleted, set it ="@".
S:$G(BIOLOC)="" BIOLOC="@"
;
;---> If edit of old VISIT changed Location, edit Visit.
I $P(^AUPNVSIT(+BIVSIT,0),U,6)'=BILOC D Q
.N BIFLD S BIFLD(.06)=BILOC,BIFLD(2101)=BIOLOC
.D FDIE^BIFMAN(9000010,BIVSIT,.BIFLD,.BIERR)
.I $G(BIERR) D ERRCD^BIUTL2(433,.BIERR) S BIERR="1^"_BIERR
;
;---> If edit of old VISIT changed Outside Location, edit Visit.
;---> In old code, edit from default location to outside location failed. vvv83
I $P($G(^AUPNVSIT(+BIVSIT,21)),U)'=BIOLOC D Q
.N BIFLD S BIFLD(.06)=BILOC,BIFLD(2101)=BIOLOC
.D FDIE^BIFMAN(9000010,BIVSIT,.BIFLD,.BIERR)
.I $G(BIERR) D ERRCD^BIUTL2(434,.BIERR) S BIERR="1^"_BIERR
;
Q
;
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
;----------
CREATE(BIVSIT,BIERR,BINOM) ;EP
;---> Create a new Visit OR match on an existing Visit in VISIT File.
;---> Parameters:
; 1 - BIVSIT (ret) IEN of newly created Parent Visit.
; 2 - BIERR (ret) 1^Text of Error Code if any, otherwise null.
; 3 - BINOM (opt) 0=Allow display of Visit Selection Menu if site
; parameter is set. 1=No display (for export).
;
;---> Set permission override for this file.
S DLAYGO=9000010
;
;---> Patient.
S APCDALVR("APCDPAT")=BIDFN
;
;---> PCC Date/Time; If no time, 12 noon will be attached.
S APCDALVR("APCDDATE")=BIDATE
;
;---> If Visit Selection Menu is Disabled, create/link automatically:
;---> Linking/Adding PCC Visits:
;---> 1) If no Visit exists on this date, create one silently.
;---> 2) If a Visit exists with exact time match, append to it.
;---> 3) If a Visit exists for this date but a different time,
;---> add a new Visit.
;
;---> If site param says do NOT display Visit Selection Menu, then
;---> link or create automatically.
D
.;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
.;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
.I $G(BINOM) S APCDALVR("APCDAUTO")="" Q
.;**********
.I '$$VISMNU^BIUTL2(BISITE) S APCDALVR("APCDAUTO")="" Q
.K APCDALVR("APCDAUTO")
;
;---> No interaction, no Fileman echoing. Archaic?
S APCDALVR("AUPNTALK")="",APCDALVR("APCDANE")=""
;
S APCDALVR("APCDLOC")=BILOC
;
;---> Other Location (Text if Location="OTHER").
S APCDALVR("APCDOLOC")=$G(BIOLOC)
;
;---> Set Type of Visit from PCC MASTER CONTROL File. (I,C,T,6,V)
N BITYPE D
.D:'$G(BISITE) SETVARS^BIUTL5 S BISITE=DUZ(2)
.I $G(^APCCCTRL(BISITE,0))="" S BITYPE="I" Q
.S BITYPE=$P(^APCCCTRL(BISITE,0),U,4)
.S:BITYPE="" BITYPE="I"
S APCDALVR("APCDTYPE")=BITYPE
;
;---> Category. A=Ambulatory, I=Inpatient, E=Event/Historical.
;---> If User said this was an Ambulatory Visit, and if the Inpatient Visit
;---> Check Site Parameter is enabled, check to see if patient was an
;---> Inpatient on BIDATE; if so, change Category to "I",Inpatient.
;
I BICAT="A",$$INPTCHK^BIUTL2(BISITE),$$INPT^BIUTL11(BIDFN,BIDATE) S BICAT="I"
S APCDALVR("APCDCAT")=BICAT
;
;---> Call to add (create) Visit.
;---> NOTE: $G(BICAT)="E" (Historical) will override Active/Inactive
;---> selection screen on .01 Field of Immunization File #9999999.14.
;
;---> If PIMS is loaded, call new API.
;---> *** Use this below to test version of BSDAPI4?:
;---> I $P($T(BSDAPI4+1^BSDAPI4),"**",2)>1002
D
.;---> Check for PIMS (following lines from bottom of APCDAPI4).
.;I $L($T(^APCDAPI4)),$L($T(VISIT^BSDV)),$L($T(GETVISIT^BSDAPI4)) D NEWCALL Q
.D OLDCALL
;
Q:$G(BIERR)
;
;S BITEST=1
D:$G(BITEST) DISPLAY1^BIPCC
;
;---> Quit if Visit was not created.
I '$G(APCDALVR("APCDVSIT"))!($D(APCDALVR("APCDAFLG"))) D Q
.D ERRCD^BIUTL2(401,.BIERR) S BIERR="1^"_BIERR
;
;Returns: APCDVSIT - Pointer to Visit just selected or created.
; APCDVSIT("NEW") - If ^APCDALVR created a new Visit.
; APCDAFLG - =2 If FAILED to select or create a Visit.
;
;---> Save IEN of Visit just created.
S BIVSIT=APCDALVR("APCDVSIT")
Q
;
;
;----------
OLDCALL ;EP
;---> Create a Visit in VISIT File using APCDALV.
;---> Parameters per above.
;---> No new PIMS, call Lori's older API.
I '$D(APCDALVR("APCDAUTO")) D FULL^VALM1 W:$D(IOF) @IOF
D EN^APCDALV
Q
;
;
;----------
NEWCALL ;EP
;---> Create a Visit in VISIT File using new PIMS 5.3+.
;---> Parameters per above.
;---> No new PIMS, call Lori's older API.
;
;W !,"IN NEWCALL." R ZZZ
N APCDIN,APCDOUT
;S APCDIN("ANCILLARY")=1
S APCDIN("SHOW VISITS")=1
S APCDIN("PAT")=APCDALVR("APCDPAT")
S APCDIN("VISIT DATE")=APCDALVR("APCDDATE")
S APCDIN("SITE")=APCDALVR("APCDLOC")
S APCDIN("VISIT TYPE")=APCDALVR("APCDTYPE")
S APCDIN("SRV CAT")=APCDALVR("APCDCAT")
S APCDIN("TIME RANGE")=60
S APCDIN("USR")=$S($G(DUZ):DUZ,1:1)
S APCDIN("APCDLOC")=APCDALVR("APCDLOC")
S:($G(APCDALVR("APCDOLOC"))]"") APCDIN("APCDOLOC")=APCDALVR("APCDOLOC")
;
;---> Go get or create a Visit.
D
.;---> If Visit Selection Menu is disabled, make an automated call.
.;---> Link to a Visit within 30 minutes.
.I '$$VISMNU^BIUTL2(BISITE) D GETVISIT^APCDAPI4(.APCDIN,.APCDOUT) Q
.;
.;---> Okay, Visit Selection Menu is enabled.
.;---> Don't match on time.
.S APCDIN("TIME RANGE")=-1
.S APCDIN("NEVER ADD")=1
.D GETVISIT^APCDAPI4(.APCDIN,.APCDOUT)
.N BIPAT S BIPAT("PAT")=BIDFN
.D FULL^VALM1 W:$D(IOF) @IOF
.D SELECT^BSDAPI5(.BIPAT,.APCDOUT) ;THIS IS NOT A P.E.P. (CANNOT CALL IT).
.;
;
;X ^O
;
;---> Variable containing parent IEN does not exist, so error out.
I '$D(APCDOUT(0)) D ERRCD^BIUTL2(435,.BIERR) S BIERR="1^"_BIERR Q
;
;---> No Visits matching and none created, so error out.
I $P(APCDOUT(0),U)=0 S BIERR="1^"_$P(APCDOUT(0),U,2) Q
;
;---> One Visit (matched or created), so set Visit IEN.
S:APCDOUT(0)=1 APCDALVR("APCDVSIT")=$O(APCDOUT(0))
;
;---> If more than one Visit matches within 60 minutes, choose
;---> the closest in time.
D:APCDOUT(0)>1
.;---> Creat array based on time difference.
.N A,X,Y S X=0
.F S X=$O(APCDOUT(X)) Q:'X D
..;
..;---> Allow for negative values of Y (in time difference).
..S Y=APCDOUT(X) I Y]"" S:Y<0 Y=-Y S A(Y)=X
.;
.;X ^O
.;---> Now grab the IEN of the closest Visit in time.
.S Y="",X=""
.F S Y=$O(A(Y)) Q:Y="" Q:$G(APCDALVR("APCDVSIT")) D
..I ((Y=0)!(Y>0)),A(Y)>0 S APCDALVR("APCDVSIT")=A(Y) Q
;
;---> Got a valid Visit IEN, so quit.
Q:$G(APCDALVR("APCDVSIT"))
;
;---> None of the above cases match, so error out.
D ERRCD^BIUTL2(438,.BIERR) S BIERR="1^"_BIERR
;
Q
BIVISIT1 ;IHS/CMI/MWR - CREATE/EDIT VISITS.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**5**;JUL 01,2013
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; CODE TO CREATE OR EDIT VISITS FOR IMMUNIZATIONS AND SKIN TESTS.
+4 ;; PATCH 1: Allow for negative values of Y (time difference). CREATE+91
+5 ;; Correct "Other" Location not getting set during edits. VISIT+14
+6 ;; PATCH 5: Added BINOM parameter to ADDEDIT P.E.P. for Visit Selection Menu.
+7 ;; VISIT+0
+8 ;
+9 ;
+10 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+11 ;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
+12 ;----------
VISIT(BIDFN,BIDATE,BICAT,BILOC,BIOLOC,BISITE,BIVSIT,BIERR,BINOM) ;EP
+1 ;---> Create or edit a Visit for this patient's Immunization or
+2 ;---> Skin Test. Called by BIVISIT.
+3 ;---> Parameters:
+4 ; 1 - BIDFN (req) DFN of patient.
+5 ; 2 - BIDATE (req) Date.Time of Visit.
+6 ; 3 - BILOC (req) Location of encounter IEN.
+7 ; 4 - BIOLOC (opt) Other Location of encounter.
+8 ; 5 - BICAT (req) Category: A (Ambul), I (Inpat), E (Event/Hist)
+9 ; 6 - BISITE (req) DUZ(2) for Site Parameters.
+10 ; 7 - BIVSIT (ret) IEN of Visit (may exist already or be new).
+11 ; 8 - BIERR (ret) Text of Error Code if any, otherwise null.
+12 ; 9 - BINOM (opt) 0=Allow display of Visit Selection Menu if site
+13 ; parameter is set. 1=No display (for export).
+14 ;
+15 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+16 ;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
+17 IF ($GET(BINOM)="")
SET BINOM=0
+18 ;
+19 ;---> First, determine Location.
+20 ;---> If BILOC<1 or if Outside Location is not null set BILOC equal
+21 ;---> to "OTHER" entry in Location File by checking BI SITE Parameter.
+22 IF ('$GET(BILOC)!($GET(BIOLOC)]""))
SET BILOC=$$OTHERLOC^BIUTL6(DUZ(2))
+23 ;
+24 ;---> Quit if "OTHER" Location has not been selected in Site Parameters.
+25 IF 'BILOC
SET BIERR="1^"_$$OTHERLOC^BIUTL6(DUZ(2),1)
QUIT
+26 ;
+27 ;---> Create Visit if necessary.
+28 ;
+29 ;---> If no Parent Visit EIN, create a new Visit.
+30 IF '$GET(BIVSIT)
DO CREATE(.BIVSIT,.BIERR,BINOM)
QUIT
+31 ;
+32 ;---> If Parent Visit doesn't really exist, create a new Visit.
+33 IF '$GET(^AUPNVSIT(+BIVSIT,0))
DO CREATE(.BIVSIT,.BIERR,BINOM)
QUIT
+34 ;
+35 ;---> If edit of old VISIT changed Date.Time, create a new Visit.
+36 IF $PIECE(^AUPNVSIT(+BIVSIT,0),U)'=BIDATE
DO CREATE(.BIVSIT,.BIERR,BINOM)
QUIT
+37 ;
+38 ;---> If edit of old VISIT changed Category, create a new Visit.
+39 IF $PIECE(^AUPNVSIT(+BIVSIT,0),U,7)'=BICAT
DO CREATE(.BIVSIT,.BIERR,BINOM)
QUIT
+40 ;
+41 ;
+42 ;---> If Outside Location was deleted, set it ="@".
+43 IF $GET(BIOLOC)=""
SET BIOLOC="@"
+44 ;
+45 ;---> If edit of old VISIT changed Location, edit Visit.
+46 IF $PIECE(^AUPNVSIT(+BIVSIT,0),U,6)'=BILOC
Begin DoDot:1
+47 NEW BIFLD
SET BIFLD(.06)=BILOC
SET BIFLD(2101)=BIOLOC
+48 DO FDIE^BIFMAN(9000010,BIVSIT,.BIFLD,.BIERR)
+49 IF $GET(BIERR)
DO ERRCD^BIUTL2(433,.BIERR)
SET BIERR="1^"_BIERR
End DoDot:1
QUIT
+50 ;
+51 ;---> If edit of old VISIT changed Outside Location, edit Visit.
+52 ;---> In old code, edit from default location to outside location failed. vvv83
+53 IF $PIECE($GET(^AUPNVSIT(+BIVSIT,21)),U)'=BIOLOC
Begin DoDot:1
+54 NEW BIFLD
SET BIFLD(.06)=BILOC
SET BIFLD(2101)=BIOLOC
+55 DO FDIE^BIFMAN(9000010,BIVSIT,.BIFLD,.BIERR)
+56 IF $GET(BIERR)
DO ERRCD^BIUTL2(434,.BIERR)
SET BIERR="1^"_BIERR
End DoDot:1
QUIT
+57 ;
+58 QUIT
+59 ;
+60 ;
+61 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+62 ;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
+63 ;----------
CREATE(BIVSIT,BIERR,BINOM) ;EP
+1 ;---> Create a new Visit OR match on an existing Visit in VISIT File.
+2 ;---> Parameters:
+3 ; 1 - BIVSIT (ret) IEN of newly created Parent Visit.
+4 ; 2 - BIERR (ret) 1^Text of Error Code if any, otherwise null.
+5 ; 3 - BINOM (opt) 0=Allow display of Visit Selection Menu if site
+6 ; parameter is set. 1=No display (for export).
+7 ;
+8 ;---> Set permission override for this file.
+9 SET DLAYGO=9000010
+10 ;
+11 ;---> Patient.
+12 SET APCDALVR("APCDPAT")=BIDFN
+13 ;
+14 ;---> PCC Date/Time; If no time, 12 noon will be attached.
+15 SET APCDALVR("APCDDATE")=BIDATE
+16 ;
+17 ;---> If Visit Selection Menu is Disabled, create/link automatically:
+18 ;---> Linking/Adding PCC Visits:
+19 ;---> 1) If no Visit exists on this date, create one silently.
+20 ;---> 2) If a Visit exists with exact time match, append to it.
+21 ;---> 3) If a Visit exists for this date but a different time,
+22 ;---> add a new Visit.
+23 ;
+24 ;---> If site param says do NOT display Visit Selection Menu, then
+25 ;---> link or create automatically.
+26 Begin DoDot:1
+27 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+28 ;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
+29 IF $GET(BINOM)
SET APCDALVR("APCDAUTO")=""
QUIT
+30 ;**********
+31 IF '$$VISMNU^BIUTL2(BISITE)
SET APCDALVR("APCDAUTO")=""
QUIT
+32 KILL APCDALVR("APCDAUTO")
End DoDot:1
+33 ;
+34 ;---> No interaction, no Fileman echoing. Archaic?
+35 SET APCDALVR("AUPNTALK")=""
SET APCDALVR("APCDANE")=""
+36 ;
+37 SET APCDALVR("APCDLOC")=BILOC
+38 ;
+39 ;---> Other Location (Text if Location="OTHER").
+40 SET APCDALVR("APCDOLOC")=$GET(BIOLOC)
+41 ;
+42 ;---> Set Type of Visit from PCC MASTER CONTROL File. (I,C,T,6,V)
+43 NEW BITYPE
Begin DoDot:1
+44 IF '$GET(BISITE)
DO SETVARS^BIUTL5
SET BISITE=DUZ(2)
+45 IF $GET(^APCCCTRL(BISITE,0))=""
SET BITYPE="I"
QUIT
+46 SET BITYPE=$PIECE(^APCCCTRL(BISITE,0),U,4)
+47 IF BITYPE=""
SET BITYPE="I"
End DoDot:1
+48 SET APCDALVR("APCDTYPE")=BITYPE
+49 ;
+50 ;---> Category. A=Ambulatory, I=Inpatient, E=Event/Historical.
+51 ;---> If User said this was an Ambulatory Visit, and if the Inpatient Visit
+52 ;---> Check Site Parameter is enabled, check to see if patient was an
+53 ;---> Inpatient on BIDATE; if so, change Category to "I",Inpatient.
+54 ;
+55 IF BICAT="A"
IF $$INPTCHK^BIUTL2(BISITE)
IF $$INPT^BIUTL11(BIDFN,BIDATE)
SET BICAT="I"
+56 SET APCDALVR("APCDCAT")=BICAT
+57 ;
+58 ;---> Call to add (create) Visit.
+59 ;---> NOTE: $G(BICAT)="E" (Historical) will override Active/Inactive
+60 ;---> selection screen on .01 Field of Immunization File #9999999.14.
+61 ;
+62 ;---> If PIMS is loaded, call new API.
+63 ;---> *** Use this below to test version of BSDAPI4?:
+64 ;---> I $P($T(BSDAPI4+1^BSDAPI4),"**",2)>1002
+65 Begin DoDot:1
+66 ;---> Check for PIMS (following lines from bottom of APCDAPI4).
+67 ;I $L($T(^APCDAPI4)),$L($T(VISIT^BSDV)),$L($T(GETVISIT^BSDAPI4)) D NEWCALL Q
+68 DO OLDCALL
End DoDot:1
+69 ;
+70 IF $GET(BIERR)
QUIT
+71 ;
+72 ;S BITEST=1
+73 IF $GET(BITEST)
DO DISPLAY1^BIPCC
+74 ;
+75 ;---> Quit if Visit was not created.
+76 IF '$GET(APCDALVR("APCDVSIT"))!($DATA(APCDALVR("APCDAFLG")))
Begin DoDot:1
+77 DO ERRCD^BIUTL2(401,.BIERR)
SET BIERR="1^"_BIERR
End DoDot:1
QUIT
+78 ;
+79 ;Returns: APCDVSIT - Pointer to Visit just selected or created.
+80 ; APCDVSIT("NEW") - If ^APCDALVR created a new Visit.
+81 ; APCDAFLG - =2 If FAILED to select or create a Visit.
+82 ;
+83 ;---> Save IEN of Visit just created.
+84 SET BIVSIT=APCDALVR("APCDVSIT")
+85 QUIT
+86 ;
+87 ;
+88 ;----------
OLDCALL ;EP
+1 ;---> Create a Visit in VISIT File using APCDALV.
+2 ;---> Parameters per above.
+3 ;---> No new PIMS, call Lori's older API.
+4 IF '$DATA(APCDALVR("APCDAUTO"))
DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+5 DO EN^APCDALV
+6 QUIT
+7 ;
+8 ;
+9 ;----------
NEWCALL ;EP
+1 ;---> Create a Visit in VISIT File using new PIMS 5.3+.
+2 ;---> Parameters per above.
+3 ;---> No new PIMS, call Lori's older API.
+4 ;
+5 ;W !,"IN NEWCALL." R ZZZ
+6 NEW APCDIN,APCDOUT
+7 ;S APCDIN("ANCILLARY")=1
+8 SET APCDIN("SHOW VISITS")=1
+9 SET APCDIN("PAT")=APCDALVR("APCDPAT")
+10 SET APCDIN("VISIT DATE")=APCDALVR("APCDDATE")
+11 SET APCDIN("SITE")=APCDALVR("APCDLOC")
+12 SET APCDIN("VISIT TYPE")=APCDALVR("APCDTYPE")
+13 SET APCDIN("SRV CAT")=APCDALVR("APCDCAT")
+14 SET APCDIN("TIME RANGE")=60
+15 SET APCDIN("USR")=$SELECT($GET(DUZ):DUZ,1:1)
+16 SET APCDIN("APCDLOC")=APCDALVR("APCDLOC")
+17 IF ($GET(APCDALVR("APCDOLOC"))]"")
SET APCDIN("APCDOLOC")=APCDALVR("APCDOLOC")
+18 ;
+19 ;---> Go get or create a Visit.
+20 Begin DoDot:1
+21 ;---> If Visit Selection Menu is disabled, make an automated call.
+22 ;---> Link to a Visit within 30 minutes.
+23 IF '$$VISMNU^BIUTL2(BISITE)
DO GETVISIT^APCDAPI4(.APCDIN,.APCDOUT)
QUIT
+24 ;
+25 ;---> Okay, Visit Selection Menu is enabled.
+26 ;---> Don't match on time.
+27 SET APCDIN("TIME RANGE")=-1
+28 SET APCDIN("NEVER ADD")=1
+29 DO GETVISIT^APCDAPI4(.APCDIN,.APCDOUT)
+30 NEW BIPAT
SET BIPAT("PAT")=BIDFN
+31 DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+32 ;THIS IS NOT A P.E.P. (CANNOT CALL IT).
DO SELECT^BSDAPI5(.BIPAT,.APCDOUT)
+33 ;
End DoDot:1
+34 ;
+35 ;X ^O
+36 ;
+37 ;---> Variable containing parent IEN does not exist, so error out.
+38 IF '$DATA(APCDOUT(0))
DO ERRCD^BIUTL2(435,.BIERR)
SET BIERR="1^"_BIERR
QUIT
+39 ;
+40 ;---> No Visits matching and none created, so error out.
+41 IF $PIECE(APCDOUT(0),U)=0
SET BIERR="1^"_$PIECE(APCDOUT(0),U,2)
QUIT
+42 ;
+43 ;---> One Visit (matched or created), so set Visit IEN.
+44 IF APCDOUT(0)=1
SET APCDALVR("APCDVSIT")=$ORDER(APCDOUT(0))
+45 ;
+46 ;---> If more than one Visit matches within 60 minutes, choose
+47 ;---> the closest in time.
+48 IF APCDOUT(0)>1
Begin DoDot:1
+49 ;---> Creat array based on time difference.
+50 NEW A,X,Y
SET X=0
+51 FOR
SET X=$ORDER(APCDOUT(X))
IF 'X
QUIT
Begin DoDot:2
+52 ;
+53 ;---> Allow for negative values of Y (in time difference).
+54 SET Y=APCDOUT(X)
IF Y]""
IF Y<0
SET Y=-Y
SET A(Y)=X
End DoDot:2
+55 ;
+56 ;X ^O
+57 ;---> Now grab the IEN of the closest Visit in time.
+58 SET Y=""
SET X=""
+59 FOR
SET Y=$ORDER(A(Y))
IF Y=""
QUIT
IF $GET(APCDALVR("APCDVSIT"))
QUIT
Begin DoDot:2
+60 IF ((Y=0)!(Y>0))
IF A(Y)>0
SET APCDALVR("APCDVSIT")=A(Y)
QUIT
End DoDot:2
End DoDot:1
+61 ;
+62 ;---> Got a valid Visit IEN, so quit.
+63 IF $GET(APCDALVR("APCDVSIT"))
QUIT
+64 ;
+65 ;---> None of the above cases match, so error out.
+66 DO ERRCD^BIUTL2(438,.BIERR)
SET BIERR="1^"_BIERR
+67 ;
+68 QUIT
