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