Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BIVISIT1

BIVISIT1.m

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