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

BSDV.m

Go to the documentation of this file. 
  1. BSDV ; IHS/ANMC/LJF - CREATE VISIT AT CHECK-IN ;  
  1.  ;;5.3;PIMS;**1003,1007,1009,1012,1015,1016**;DEC 01, 2006;Build 20
  1.  ;ihs/cmi/maw 04/27/2012 added PP and PROVIDER PROBLEM check for Yakama
  1.  ;IHS/ITSC/LJF 04/22/2005 PATCH 1003 code changed to use new Visit Creation API
  1.  ;                                   updated code to adjust visit pointers in PE file
  1.  ;             07/06/2005 PATCH 1003 fixed clinic code so alpha-numeric codes work as defaults
  1.  ;cmi/anch/maw 11/22/2006 PATCH 1007 added code in VISIT to screen on phone in check in
  1.  ;cmi/anch/maw 05/09/2008 PATCH 1009 requirement 65 added code in CHKIN,VSTUPD to show other info if site parameter is setup, allow edit of clinic,provider
  1.  ;cmi/anch/maw 06/10/2008 PATCH 1009 requirement 58 visit API enhancements, add check of existing visits at checkin
  1.  ;ihs/cmi/maw 08/01/2012 PATCH 1015 add BSDV false errors to determine other apps calling API and failing
  1.  ;
  1. CHKIN(BSDEVT,BSDCLN,BSDDT,APTN,DFN) ;EP; -- ask visit related check-in questions
  1.  ; called by Scheduling Event driver
  1.  ; user interface for 2 questions (clinic code and provider)
  1.  ; Input variables:
  1.  ;      BSDEVT = type of event (4=checkin)
  1.  ;      BSDCLN = clinic ien
  1.  ;      BSDDT  = appt date/time
  1.  ;      APTN   = ien for appt under date mutiple
  1.  ;      DFN    = patient ien
  1.  Q:$G(BSDEVT)'=4  ;quit if not a checkin
  1.  Q:'$G(DFN)  Q:'$G(BSDCLN)  Q:'$G(BSDDT)  Q:'$G(APTN)
  1.  I $$GET1^DIQ(9009017.2,+BSDCLN,.09)'="YES" Q  ;don't create visit
  1.  ; if patient already checked in, use VDATE code
  1.  I $P(SDATA("BEFORE","STATUS"),U,4)]"" D  Q
  1.  . N BSDMSG
  1.  . D VDATE(BSDEVT,BSDCLN,BSDDT,APTN,DFN,$P(SDATA("BEFORE","STATUS"),U,4),.BSDMSG)
  1.  . D VSTUPD(BSDCLN,BSDDT,APTN,DFN,.BSDMSG)
  1.  . ;
  1.  . ; display any messages (error messages in reverse video)
  1.  . I $D(BSDMSG) D
  1.  .. NEW I F I=1:1 Q:'$D(BSDMSG(I))  D
  1.  ... I $P(BSDMSG(I),U)>0,$G(IORVON) D MSG(IORVON_$P(BSDMSG(I),U,2)_IORVOFF,1,0),PAUSE^BDGF Q
  1.  ... D MSG($P(BSDMSG(I),U,2),1,0)
  1.  Q:'$G(^SC(+BSDCLN,"S",BSDDT,1,APTN,"C"))  ;not checked-in
  1.  N BSDCC,BSDVP,BSDMSG
  1.  ;cmi/anch/maw 5/9/2008 PATCH 1009 rqmt 65 show other info if site param set to yes
  1.  I BSDCLN,$O(^BSDSC("B",BSDCLN,0)) D
  1.  . N BSDOI,BSDOIA
  1.  . S BSDOI=$O(^BSDSC("B",BSDCLN,0))
  1.  . Q:'$P($G(^BSDSC(BSDOI,0)),U,13)  ;quit if not a multiple code clinic
  1.  . Q:'$P($G(^BSDSC(BSDOI,0)),U,17)  ;quit if other info is set to no
  1.  . S BSDOIA=$$OI^BSDAM(BSDCLN,BSDDT,APTN,DFN)  ;show/allow edit of other info
  1.  ;cmi/anch/maw 5/9/2008 PATCH 1009 end of mods
  1.  S BSDCC=$$CLNCODE(BSDCLN)        ;ask clinic code
  1.  S BSDVP=$$PROV(BSDCLN)           ;ask visit provider
  1.  ;IHS/ITSC/LJF 5/4/2005 PATCH 1003 add call to new API - GETVISIT^BSDAPI4
  1.  NEW BSDVAR,BSDOUT
  1.  S BSDVAR("NEVER ADD")=1              ;first time through just check for matches
  1.  D SETVAR                             ;set basic variables for API call
  1.  D GETVISIT^BSDAPI4(.BSDVAR,.BSDOUT)   ;call new API
  1.  K BSDVAR
  1.  I BSDOUT(0)=1 S BSDVSTN=$O(BSDOUT(0))         ;if match found, set visit IEN
  1.  ;IHS/ITSC/LJF 5/4/2005 end of PATCH 1003 mods
  1.  D VISIT(BSDCLN,BSDDT,APTN,DFN,BSDCC,BSDVP,.BSDMSG)   ;create visit call
  1.  I $D(BSDMSG) D
  1.  . NEW I F I=1:1 Q:'$D(BSDMSG(I))  D MSG($P(BSDMSG(I),U,2),1,0)
  1.  . D PAUSE^BDGF
  1.  Q
  1.  ;
  1. VISIT(BSDCLN,BSDDT,APTN,DFN,BSDCC,BSDPROV,BSDOPT,BSDMSG) ;EP; -- create visit
  1.  ;IHS/ITSC/LJF 4/22/2005 PATCH 1003 code rewritten to call new Visit Creation API (BSDAPI4)
  1.  ;
  1.  ; called by CHKIN subroutine above and by applications where
  1.  ; all data is already known
  1.  ; silent update to database; no user interface
  1.  ; Input variables:
  1.  ;      BSDCLN  = clinic ien
  1.  ;      BSDDT   = appt date/time
  1.  ;      APTN    = ien for appt under date mutiple
  1.  ;      DFN     = patient ien
  1.  ;      BSDCC   = clinic code ien
  1.  ;      BSDPROV = visit provider ien
  1.  ;      BSDOPT  = option used to create visit (optional) ;IHS/ITSC/LJF 9/18/2003 new variable
  1.  ;      BSDMSG  = called by reference, upon exit contains user msgs
  1.  ;                first piece is error code; 2nd piece is message
  1.  ;                Error = 0 (no problems)
  1.  ;                        1 (problem setting visit variables)
  1.  ;                        2 (problem creating visit)
  1.  ;                        3 (problem changing visit date/time)
  1.  Q:'$G(BSDCLN)  Q:'$G(BSDDT)  Q:'$G(APTN)  Q:'$G(DFN)
  1.  Q:'$G(BSDCC)
  1.  I $$GET1^DIQ(9009017.2,+BSDCLN,.09)'="YES" Q  ;don't create visit
  1.  Q:'$G(^SC(+BSDCLN,"S",BSDDT,1,APTN,"C"))  ;not checked-in
  1.  ;IHS/ITSC/LJF 4/28/2005 PATCH 1003
  1.  I $G(BSDVSTN) D PROVUPD,HOSLUPD Q   ;if have visit already, update providers & clinic then quit
  1.  ; else create visit, add provider and create VCN
  1.  N BSDVAR,BSDRET
  1.  D SETVAR
  1.  S BSDVAR("APCDAPPT")=$S($P(^DPT(DFN,"S",BSDDT,0),U,7)=3:"A",$P(^DPT(DFN,"S",BSDDT,0),U,7)=4:"W",1:"U")    ;walk-in vs appt
  1.  I "CT"[BSDVAR("SRV CAT") K BSDVAR("APCDAPPT")  ;IHS/OIT/LJF 11/17/2006 PATCH 1007 not needed for phone calls & cr
  1.  I $G(BSDOPT)]"" S BSDVAR("APCDOPT")=$O(^DIC(19,"B",BSDOPT,0))  ;option used
  1.  E  S BSDVAR("APCDOPT")=$O(^DIC(19,"B","SD IHS PCC LINK",0))
  1.  S BSDVAR("SHOW VISITS")=1  ;cmi/maw 6/10/2008 PATCH 1009 variable to show visits to link to
  1.  S BSDVAR("CALLER")="BSD CHECKIN"  ;cmi/maw 6/10/2008 PATCH 1009 add variable that shows who the caller is for API
  1.  K BSDR("VIEN")  ;ihs/cmi/maw 06/05/2012 hangs around after a multiple visit but gets set in BSDAPI5 on a multiple visit
  1.  D GETVISIT^BSDAPI4(.BSDVAR,.BSDRET)
  1.  I BSDRET(0)>1 D  ;cmi/maw 9/21/2010
  1.  . D SELECT^BSDAPI5(.BSDVAR,.BSDRET)
  1.  I '$G(BSDR("VIEN")) D
  1.  . S BSDVAR("FORCE ADD")=1
  1.  . D GETVISIT^BSDAPI4(.BSDVAR,.BSDRET)
  1.  D MSGADD(0,"Visit Attached/Created.")
  1.  S BSDVSTN=$O(BSDRET(0))
  1.  I '$G(BSDVSTN) S MAW="S $ZE=""BSDV NO VISIT CREATED"" D ^ZTER" X MAW K MAW Q  ;patch 1016 10/23/2012 quit if no visit
  1.  I $G(BSDR("VIEN")) S BSDVSTN=BSDR("VIEN")  ;cmi/maw 6/10/2008 set to selected visit var
  1.  ;IHS/ITSC/LJF 4/28/2005 PATCH 1003 end of rewritten code
  1.  ; -- add provider to visit
  1.  I $G(BSDPROV),'$$PP(BSDVSTN,BSDPROV),$P($G(^AUPNVSIT(BSDVSTN,0)),U,5)=DFN D  ;ihs/cmi/maw PATCH 1015 07/12/2012 make sure visit patient and dfn are same before adding provider
  1.  . K APCDALVR
  1.  . S APCDALVR("APCDTPRO")="`"_BSDPROV
  1.  . S APCDALVR("APCDPAT")=DFN
  1.  . S APCDALVR("APCDVSIT")=BSDVSTN
  1.  . S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
  1.  . S APCDALVR("APCDTPS")="P",APCDALVR("APCDTOA")=""
  1.  . D ^APCDALVR
  1.  . D MSGADD(0,"Provider added to visit.")
  1.  ; -- create VCN and add to visit
  1.  S BSDVCN="" I $T(VCN^AUPNVSIT)]"" S BSDVCN=$$VCN^AUPNVSIT(BSDVSTN,1)
  1.  ;DO NOT KILL BSDVSTN, BSDVCN OR BSDOPT; KILLED AT END OF EVT DRIVER
  1. VSTEND D EN1^APCDEKL,EN2^APCDEKL K APCDALVR,X
  1.  Q
  1.  ;
  1. PP(VSTN,PROV) ;
  1.  N FOUND,IEN,PRIM,PRV
  1.  S (IEN,FOUND,PRIM)=0
  1.  I '$G(VSTN) Q FOUND
  1.  F  S IEN=$O(^AUPNVPRV("AD",VSTN,IEN)) Q:'IEN  D
  1.  . I $P($G(^AUPNVPRV(IEN,0)),U)=PROV S FOUND=1   ;provider on visit
  1.  . I $$GET1^DIQ(9000010.06,IEN,.04)="PRIMARY" S FOUND=1  ;do not allow multiple primary providers
  1.  I $G(FOUND) S MAW="S $ZE=""BSDV MULT PRIM PROV PROBLEM"" D ^ZTER" X MAW K MAW
  1.  Q $G(FOUND)           ;PRIMARY already on visit
  1.  ;
  1. VDATE(BSDEVT,BSDCLN,BSDDT,APTN,DFN,BSDCKO,BSDMSG) ;EP
  1.  ;if new time entered, update visit
  1.  ; called by Scheduling Event Driver; use if check-in time was changed
  1.  ; silent update to database; no user interface
  1.  ; Input variables:
  1.  ;    BSDEVT    =  type of event (4=checkin)
  1.  ;    BSDCLN    =  clinic ien
  1.  ;    BSDDT     =  appt date & time
  1.  ;    APTN      =  ien for appt under date multiple
  1.  ;    DFN       =  Patient ien
  1.  ;    BSDCKO    =  old check-in date/time
  1.  ;    BSDMSG    =  called by reference, upon exit contains user msgs
  1.  ;
  1.  Q:$G(BSDEVT)'=4   ;quit if not a checkin
  1.  I $$GET1^DIQ(9009017.2,+BSDCLN,.09)'="YES" Q  ;don't create visit
  1.  N APCDVSIT,BSDCK
  1.  ; find visit based on old check-in time
  1.  S APCDVSIT=$O(^AUPNVSIT("AA",DFN,$$RDT(BSDCKO),0)) Q:'APCDVSIT
  1.  I $O(^AUPNVSIT("AA",DFN,$$RDT(BSDCKO),APCDVSIT)) D MSGADD(4,"More than 1 visit for date/time; visit must be updated manually.") Q
  1.  ; get new check-in time
  1.  S BSDCK=$G(^SC(BSDCLN,"S",BSDDT,1,APTN,"C")) Q:BSDCK=BSDCKO
  1.  ;delete visit if check-in date deleted and visit not yet coded
  1.  I 'BSDCK D  Q
  1.  . ;IHS/ITSC/LJF 5/4/2005 PATCH 1003 delete OE file visit pointer
  1.  . N OEN,OENV
  1.  . S OEN=$P(^DPT(DFN,"S",BSDDT,0),U,20) I OEN D
  1.  . . S OENV=$$GET1^DIQ(409.68,+OEN,.05,"I")
  1.  . . I OENV S DIE="^SCE(",DA=OEN,DR=".05///@" D ^DIE
  1.  . ; don't delete visit if another appt points to it in OE file
  1.  . I $G(OENV) Q:$O(^SCE("AVSIT",OENV,0))
  1.  . ; end of PATCH 1003 change
  1.  . N DEP S APCDVDLT=APCDVSIT,DEP=+$$GET1^DIQ(9000010,APCDVSIT,.09)
  1.  . I (DEP=0)!((DEP=1)&($O(^AUPNVPRV("AD",APCDVSIT,0)))) D ^APCDVDLT Q
  1.  . N DIE,DA,DR S DIE=9000010,DA=APCDVSIT
  1.  . S DR="81101///SCHED COULD NOT DELETE VISIT WHEN CHECKIN DELETED"
  1.  . D ^DIE
  1.  ;if visit date/time does NOT match new check-in date/time, modify it 
  1.  I $$GET1^DIQ(9000010,APCDVSIT,.01,"I")'=BSDCK D
  1.  . S APCDCVDT("VISIT DFN")=APCDVSIT
  1.  . S APCDCVDT("VISIT DATE/TIME")=BSDCK
  1.  . D ^APCDCVDT
  1.  . I $D(APCDCVDT("ERROR FLAG")) D MSGADD(3,"Changing visit date/time failed.  Please notify your supervisor.") Q
  1.  . K APCDCVDT
  1.  . D MSGADD(0,"Visit Date/Time Updated.")
  1.  Q
  1.  ;
  1. RDT(X) ; -- reverse date
  1.  Q 9999999-$P(X,".")_"."_$P(X,".",2)
  1.  ;
  1. CLNCODE(CLINIC) ; -- asks user for clinic code
  1.  N Y,DIR,CODE
  1.  F  Q:$G(Y)>0  D
  1.  . S DIR(0)="P^40.7:EMZQ",DIR("A")="CLINIC CODE for VISIT"
  1.  . S CODE=$$GET1^DIQ(40.7,+$$GET1^DIQ(44,CLINIC,8,"I"),1)  ;code #
  1.  . ;do not set default if multiple clinic codes used in clinic
  1.  . ;I CODE,$$GET1^DIQ(9009017.2,CLINIC,.13)'="YES" S DIR("B")=CODE
  1.  . I CODE]"",$$GET1^DIQ(9009017.2,CLINIC,.13)'="YES" S DIR("B")=CODE  ;IHS/ITSC/LJF 7/6/2005 PATCH 1003
  1.  . S DIR("?")="This is required.  Please try again"
  1.  . D ^DIR
  1.  Q +Y
  1.  ;
  1. PROV(CLINIC) ; - asks user for visit provider
  1.  N DIC,X,Y
  1.  F  Q:($G(Y)>0)  D
  1.  . S DIC=200,DIC(0)="AMEQZ",DIC("A")="VISIT PROVIDER:  "
  1.  . S DIC("B")=$$GET1^DIQ(200,+$$PRV^BSDU(CLINIC),.01)
  1.  . I DIC("B")="" K DIC("B")
  1.  . S DIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))"
  1.  . D ^DIC K DIC
  1.  . I Y<1,$$GET1^DIQ(9009017.2,CLINIC,.14)'="YES" S Y="1^QUIT" Q
  1.  . I Y<1 D MSG("This is required.  Please try again.",1,0)
  1.  I $P(Y,U,2)="QUIT" Q 0
  1.  Q $$PRVIEN(+Y)
  1.  ;
  1. PRVIEN(Y) ; -- determines correct provider file to use
  1.  I $P(^DD(9000010.06,.01,0),U,2)["200" Q +Y
  1.  Q $P(^VA(200,+Y,0),U,16)
  1.  ;
  1.  ;
  1. MSGADD(ERROR,STRING) ; -- put message string into array
  1.  N I
  1.  S I=$O(BSDMSG(""),-1)+1   ;get next subscript
  1.  S BSDMSG(I)=ERROR_U_STRING
  1.  Q
  1.  ;
  1. MSG(DATA,PRE,POST) ; -- writes line to device
  1.  N I,FORMAT
  1.  S FORMAT="" I PRE>0 F I=1:1:PRE S FORMAT=FORMAT_"!"
  1.  D EN^DDIOL(DATA,"",FORMAT)
  1.  I POST>0 F I=1:1:POST D EN^DDIOL("","","!")
  1.  Q
  1.  ;
  1. FAC(CLINIC) ; -- return facility location ien for clinic
  1.  ; try institution field in file 44, then institution based on division
  1.  ; then try user's division and make sure it is a PCC site
  1.  N FAC
  1.  S FAC=$$GET1^DIQ(44,CLINIC,3,"I")
  1.  I 'FAC S FAC=$$GET1^DIQ(40.8,+$$GET1^DIQ(44,BSDCLN,3.5,"I"),.07,"I")
  1.  I 'FAC S FAC=$G(DUZ(2))
  1.  I '$D(^APCDSITE(+FAC)) S FAC=0
  1.  Q FAC
  1.  ;
  1. SERCAT(CLINIC,PAT) ;EP; -- returns service category for visit
  1.  NEW CLNCAT
  1.  I $G(^DPT(PAT,.1))]"" Q "I"                       ;in hospital if inpt
  1.  S CLNCAT=$$GET1^DIQ(9009017.2,CLINIC,.12,"I")     ;clinic's ser cat
  1.  Q $S(CLNCAT]"":CLNCAT,1:"A")
  1.  ;
  1. VSTUPD(BSDCLN,BSDDT,APTN,DFN,BSDMSG) ; interactive updating of visit data during ckeck-in edit
  1.  ; if check in time different, update visit if there is one
  1.  N BSDCK,AUPNVSIT,DIE,DA,DR,VPROV
  1.  ; get new check-in time
  1.  S BSDCK=+$G(^SC(BSDCLN,"S",BSDDT,1,APTN,"C")) Q:'BSDCK
  1.  ;
  1.  ; find visit based on new check-in time
  1.  S AUPNVSIT=$O(^AUPNVSIT("AA",DFN,$$RDT(BSDCK),0)) Q:'AUPNVSIT
  1.  I $O(^AUPNVSIT("AA",DFN,$$RDT(BSDCK),AUPNVSIT)) D MSGADD(4,"More than 1 visit for date/time; visit must be updated manually.") Q
  1.  ;cmi/anch/maw 5/9/2008 PATCH 1009 rqmt 65 show other info if site param set to yes
  1.  I BSDCLN,$O(^BSDSC("B",BSDCLN,0)) D
  1.  . N BSDOI,BSDOIA
  1.  . S BSDOI=$O(^BSDSC("B",BSDCLN,0))
  1.  . Q:'$P($G(^BSDSC(BSDOI,0)),U,13)  ;quit if not a multiple code clinic
  1.  . Q:'$P($G(^BSDSC(BSDOI,0)),U,17)  ;quit if other info is set to no
  1.  . S BSDOIA=$$OI^BSDAM(BSDCLN,BSDDT,APTN,DFN)  ;show/allow edit of other info
  1.  ;cmi/anch/maw 5/9/2008 PATCH 1009 end
  1.  ; update visit clinic and option used to create
  1.  S DIE=9000010,DA=AUPNVSIT,DR=".08;.24///SD IHS PCC LINK" D ^DIE,MOD^AUPNVSIT
  1.  ; if visit already has provider, edit it
  1.  NEW DA,DIE,DR
  1.  S DA=$O(^AUPNVPRV("AD",AUPNVSIT,0)) I DA D  Q
  1.  . S DIE=9000010.06,DR=".01" D ^DIE,MOD^AUPNVSIT
  1.  ; else, add v provider entry
  1.  NEW VPROV S VPROV=$$PROV(BSDCLN) I VPROV>0 D
  1.  . NEW APCDALVR
  1.  . S APCDALVR("APCDTPRO")="`"_VPROV
  1.  . S APCDALVR("APCDPAT")=DFN
  1.  . S APCDALVR("APCDVSIT")=AUPNVSIT
  1.  . S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
  1.  . S APCDALVR("APCDTPS")="P",APCDALVR("APCDTOA")=""
  1.  . D ^APCDALVR
  1.  . D MSGADD(0,"Provider added to visit.")
  1.  Q
  1.  ;
  1. PROVUPD ; will update provider on visit that was created earlier; IHS/ITSC/LJF 4/28/2005 PATCH 1003
  1.  ;if provider sent is not already on visit, assume provider should be primary
  1.  Q:'$D(BSDPROV)    ;no provider sent
  1.  Q:'$G(BSDPROV)    ;quits if provider is set to zero PATCH 1012 8/19/2010
  1.  ;look at providers on visit
  1.  N FOUND,IEN,PRIM,PRV
  1.  S (IEN,FOUND,PRIM)=0
  1.  F  S IEN=$O(^AUPNVPRV("AD",BSDVSTN,IEN)) Q:'IEN  D
  1.  . I $P($G(^AUPNVPRV(IEN,0)),U)=BSDPROV S FOUND=1   ;provider on visit
  1.  . I $$GET1^DIQ(9000010.06,IEN,.04)="PRIMARY" S PRIM=IEN
  1.  ;
  1.  I FOUND Q           ;provider already on visit, leave alone
  1.  ;
  1.  ; if other provider is primary, switch him/her to secondary
  1.  I PRIM S DIE=9000010.06,DA=PRIM,DR=".04///S" D ^DIE
  1.  ;
  1.  I $G(BSDVSTN),$P($G(^AUPNVSIT(BSDVSTN,0)),U,5)'=$G(DFN) Q  ;ihs/cmi/maw PATCH 1015 07/12/2012 don't allow a v provider update if not the correct patient for some reason
  1.  K APCDALVR
  1.  S APCDALVR("APCDTPRO")="`"_BSDPROV
  1.  S APCDALVR("APCDPAT")=DFN
  1.  S APCDALVR("APCDVSIT")=BSDVSTN
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
  1.  S APCDALVR("APCDTPS")="P",APCDALVR("APCDTOA")=""
  1.  D ^APCDALVR
  1.  D MSGADD(0,"Provider added to visit.")
  1.  Q
  1.  ;
  1. HOSLUPD ; update hospital location on visit; IHS/ITSC/LJF 5/5/2004 PATCH 1003
  1.  N DIE,DA,DR
  1.  S DIE="^AUPNVSIT(",DA=BSDVSTN,DR=".22///`"_BSDCLN
  1.  D ^DIE
  1.  Q
  1.  ;
  1. SETVAR ; IHS/ITSC/LJF 5/4/2005 PATCH 1003 sets basic variables needed by API call
  1.  S BSDVAR("PAT")=DFN,BSDVAR("VISIT DATE")=+$G(^SC(BSDCLN,"S",BSDDT,1,APTN,"C"))
  1.  S BSDVAR("SITE")=$$FAC(BSDCLN)
  1.  S BSDVAR("VISIT TYPE")=$$GET1^DIQ(9001001.2,BSDVAR("SITE"),.11,"I")
  1.  I BSDVAR("VISIT TYPE")="" S BSDVAR("VISIT TYPE")=$$GET1^DIQ(9001000,BSDVAR("SITE"),.04,"I")
  1.  I BSDVAR("VISIT TYPE")="" K BSDVAR("VISIT TYPE")
  1.  S BSDVAR("SRV CAT")=$$SERCAT(BSDCLN,DFN)
  1.  S BSDVAR("CLINIC CODE")=BSDCC
  1.  S BSDVAR("HOS LOC")=+BSDCLN
  1.  S BSDVAR("APPT DATE")=BSDDT
  1.  S BSDVAR("USR")=DUZ
  1.  S BSDVAR("TIME RANGE")=-1
  1.  Q