SDECV ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
CHKIN(BSDEVT,BSDCLN,BSDDT,APTN,DFN,BSDVSTN) ;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 multiple
; 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^SDECU 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
S BSDCC=$$CLNCODE(BSDCLN) ;ask clinic code
S BSDVP=$$PROV(BSDCLN) ;ask visit provider
; call to new API - GETVISIT^SDECAPI4
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^SDECAPI4(.BSDVAR,.BSDOUT) ;call new API
K BSDVAR
I BSDOUT(0)=1 S BSDVSTN=$O(BSDOUT(0)) ;if match found, set visit IEN
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^SDECU
Q
;
VISIT(BSDCLN,BSDDT,APTN,DFN,BSDCC,BSDPROV,BSDOPT,BSDMSG,BSDVSTN,SDECC) ;EP; -- create visit
;
; 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 multiple
; DFN = patient ien
; BSDCC = clinic code ien
; BSDPROV = visit provider ien
; BSDOPT = option used to create visit (optional)
; 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)
Q:'$G(^SC(+BSDCLN,"S",BSDDT,1,APTN,"C")) ;not checked-in
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,BSDR,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") ; 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","SDAM APPT MGT",0))
S BSDVAR("SHOW VISITS")=1 ; variable to show visits to link to
S BSDVAR("CALLER")="SDEC CHECKIN" ; add variable that shows who the caller is for API
K BSDR("VIEN") ; hangs around after a multiple visit
S BSDVAR("ADT")=$G(SDECC("ADT"))
S BSDVAR("CDT")=$G(SDECC("CDT"))
S BSDVAR("CLN")=$G(SDECC("CLN"))
S BSDVAR("PROVIDER")=$G(SDECC("PROVIDER"))
S BSDVAR("VISIT TYPE")=$G(SDECC("VISIT TYPE"))
D GETVISIT^SDECAPI4(.BSDVAR,.BSDRET)
I BSDRET(0)>1 D
. ;D SELECT^BSDAPI5(.BSDVAR,.BSDRET)
I '$G(BSDR("VIEN")) D
. S BSDVAR("FORCE ADD")=1
. D GETVISIT^SDECAPI4(.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 ; quit if no visit
I $G(BSDR("VIEN")) S BSDVSTN=BSDR("VIEN") ; set to selected visit var
; -- add provider to visit
I $G(BSDPROV),'$$PP(BSDVSTN,BSDPROV),$P($G(^AUPNVSIT(BSDVSTN,0)),U,5)=DFN D ;make sure visit patient and dfn are same before adding provider
. K SDEC
. S SDEC("PRO")=BSDPROV
. S SDEC("PAT")=DFN
. S SDEC("VST")=BSDVSTN
. S SDEC("TMP")="[SDECALVR 9000010.06 (ADD)]"
. S SDEC("TPS")="P"
. S SDEC("TOA")=""
. S SDEC("CDT")=$G(BSDVAR("CDT"))
. D VPROV^SDECALVR(.SDEC)
. D MSGADD(0,"Provider added to visit.")
;DO NOT KILL BSDVSTN, BSDVCN OR BSDOPT; KILLED AT END OF EVT DRIVER
VSTEND D EN1^SDECEKL,EN2^SDECEKL K SDECALVR,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
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
. 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^SDECU(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 service category
Q $S(CLNCAT]"":CLNCAT,1:"A")
;
VSTUPD(BSDCLN,BSDDT,APTN,DFN,BSDMSG) ; interactive updating of visit data during check-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
; if visit already has provider, edit it
NEW DA,DIE,DR
S DA=$O(^AUPNVPRV("AD",AUPNVSIT,0)) I DA D Q
. L +^AUPNVPRV(AUPNVSIT):10 Q:'$T
. S DIE=9000010.06,DR=".01" D ^DIE
. L -^AUPNVPRV(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 ^SDECALVR
. D MSGADD(0,"Provider added to visit.")
Q
;
PROVUPD ; will update provider on visit that was created earlier
;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 L +^AUPNVPRV(PRIM):10 I $T S DIE=9000010.06,DA=PRIM,DR=".04///S" D ^DIE L -^AUPNVPRV(PRIM)
;
I $G(BSDVSTN),$P($G(^AUPNVSIT(BSDVSTN,0)),U,5)'=$G(DFN) Q ; 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 ^SDECALVR
D MSGADD(0,"Provider added to visit.")
Q
;
HOSLUPD ; update hospital location on visit
N DIE,DA,DR
L +^AUPNVSIT(BSDVSTN):10
Q:'$T
S DIE="^AUPNVSIT(",DA=BSDVSTN,DR=".22///`"_BSDCLN
D ^DIE
L -^AUPNVSIT(BSDVSTN)
Q
;
SETVAR ; 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
;
EN1 ;CLEANUP
;
K Y
K AICDHLIM,XTLKHLIM
K APCDCAT,APCDCLN,APCDDATE,APCDLOC,APCDTIME,APCDTYPE,APCDVSIT,APCDLOOK,APCDTPCC,APCDTACC,APCDFV,APCDAX,APCDAL,APCDNOK,APCDEQX,APCDMOD,APCDMPQ,APCDTVST,APCDTLOC,APCDTTYP,APCDTCAT,APCDTCLN,APCDEXIT,APCDOLOC
K APCDTBP,APCDPVL,APCDAPPT,APCDEVM,APCDCODT,APCDLS,APCDVELG,APCDHL,APCDOPT,APCDPROT,APCDAPDT
K APCDPAT,APCDDOB,APCDSEX,APCDDOD,APCDRV
K AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,AUPNDAYS,AUPNVSIT ;,AUPNLK("INAC")
K APCDLPAT,APCDLDAT,APCDLVST,APCDMNE,APCDNOCL,APCDNOXV,APCDAMN
K APCDAPP,APCDBEEP,APCDDUZ,APCDDUZ2,APCDFLG,APCDL,APCDMODE,APCDOCAT,APCDODAT,APCDOTYP,APCDOVRR,APCDPVC,APCDTPLT,APCDVLK,APCDX,APCDENV,APCDEMF,APCDEIN,APCD,APCDNOXV
Q
EN2 ;CLEANUP
;I '$D(APMFMENU) K AUPNLK("ALL")
K APCDPARM,APCDNRV,APCDRVON,APCDRVOF,APCDSITE,APCDTRM,APCDDEFL,APCDDEFS,APCDDEFC,APCDDEFT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECV 12361 printed Dec 13, 2024@02:52:55 Page 2
SDECV ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
CHKIN(BSDEVT,BSDCLN,BSDDT,APTN,DFN,BSDVSTN) ;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 multiple
+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 ;I $$GET1^DIQ(9009017.2,+BSDCLN,.09)'="YES" Q ;don't create visit
+12 ; if patient already checked in, use VDATE code
+13 ;I $P(SDATA("BEFORE","STATUS"),U,4)]"" D Q
+14 ;. N BSDMSG
+15 ;. D VDATE(BSDEVT,BSDCLN,BSDDT,APTN,DFN,$P(SDATA("BEFORE","STATUS"),U,4),.BSDMSG)
+16 ;. D VSTUPD(BSDCLN,BSDDT,APTN,DFN,.BSDMSG)
+17 ;. ;
+18 ;. ; display any messages (error messages in reverse video)
+19 ;. I $D(BSDMSG) D
+20 ;.. NEW I F I=1:1 Q:'$D(BSDMSG(I)) D
+21 ;... I $P(BSDMSG(I),U)>0,$G(IORVON) D MSG(IORVON_$P(BSDMSG(I),U,2)_IORVOFF,1,0),PAUSE^SDECU Q
+22 ;... D MSG($P(BSDMSG(I),U,2),1,0)
+23 ;not checked-in
if '$GET(^SC(+BSDCLN,"S",BSDDT,1,APTN,"C"))
QUIT
+24 NEW BSDCC,BSDVP,BSDMSG
+25 ;ask clinic code
SET BSDCC=$$CLNCODE(BSDCLN)
+26 ;ask visit provider
SET BSDVP=$$PROV(BSDCLN)
+27 ; call to new API - GETVISIT^SDECAPI4
+28 NEW BSDVAR,BSDOUT
+29 ;first time through just check for matches
SET BSDVAR("NEVER ADD")=1
+30 ;set basic variables for API call
DO SETVAR
+31 ;call new API
DO GETVISIT^SDECAPI4(.BSDVAR,.BSDOUT)
+32 KILL BSDVAR
+33 ;if match found, set visit IEN
IF BSDOUT(0)=1
SET BSDVSTN=$ORDER(BSDOUT(0))
+34 ;create visit call
DO VISIT(BSDCLN,BSDDT,APTN,DFN,BSDCC,BSDVP,.BSDMSG)
+35 IF $DATA(BSDMSG)
Begin DoDot:1
+36 NEW I
FOR I=1:1
if '$DATA(BSDMSG(I))
QUIT
DO MSG($PIECE(BSDMSG(I),U,2),1,0)
+37 DO PAUSE^SDECU
End DoDot:1
+38 QUIT
+39 ;
VISIT(BSDCLN,BSDDT,APTN,DFN,BSDCC,BSDPROV,BSDOPT,BSDMSG,BSDVSTN,SDECC) ;EP; -- create visit
+1 ;
+2 ; called by CHKIN subroutine above and by applications where
+3 ; all data is already known
+4 ; silent update to database; no user interface
+5 ; Input variables:
+6 ; BSDCLN = clinic ien
+7 ; BSDDT = appt date/time
+8 ; APTN = ien for appt under date multiple
+9 ; DFN = patient ien
+10 ; BSDCC = clinic code ien
+11 ; BSDPROV = visit provider ien
+12 ; BSDOPT = option used to create visit (optional)
+13 ; BSDMSG = called by reference, upon exit contains user msgs
+14 ; first piece is error code; 2nd piece is message
+15 ; Error = 0 (no problems)
+16 ; 1 (problem setting visit variables)
+17 ; 2 (problem creating visit)
+18 ; 3 (problem changing visit date/time)
+19 if '$GET(BSDCLN)
QUIT
if '$GET(BSDDT)
QUIT
if '$GET(APTN)
QUIT
if '$GET(DFN)
QUIT
+20 if '$GET(BSDCC)
QUIT
+21 ;not checked-in
if '$GET(^SC(+BSDCLN,"S",BSDDT,1,APTN,"C"))
QUIT
+22 ;if have visit already, update providers & clinic then quit
IF $GET(BSDVSTN)
DO PROVUPD
DO HOSLUPD
QUIT
+23 ; else create visit, add provider and create VCN
+24 NEW BSDVAR,BSDR,BSDRET
+25 DO SETVAR
+26 ;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")
+27 ; not needed for phone calls & cr
IF "CT"[BSDVAR("SRV CAT")
KILL BSDVAR("APCDAPPT")
+28 ;option used
IF $GET(BSDOPT)]""
SET BSDVAR("APCDOPT")=$ORDER(^DIC(19,"B",BSDOPT,0))
+29 IF '$TEST
SET BSDVAR("APCDOPT")=$ORDER(^DIC(19,"B","SDAM APPT MGT",0))
+30 ; variable to show visits to link to
SET BSDVAR("SHOW VISITS")=1
+31 ; add variable that shows who the caller is for API
SET BSDVAR("CALLER")="SDEC CHECKIN"
+32 ; hangs around after a multiple visit
KILL BSDR("VIEN")
+33 SET BSDVAR("ADT")=$GET(SDECC("ADT"))
+34 SET BSDVAR("CDT")=$GET(SDECC("CDT"))
+35 SET BSDVAR("CLN")=$GET(SDECC("CLN"))
+36 SET BSDVAR("PROVIDER")=$GET(SDECC("PROVIDER"))
+37 SET BSDVAR("VISIT TYPE")=$GET(SDECC("VISIT TYPE"))
+38 DO GETVISIT^SDECAPI4(.BSDVAR,.BSDRET)
+39 IF BSDRET(0)>1
Begin DoDot:1
+40 ;D SELECT^BSDAPI5(.BSDVAR,.BSDRET)
End DoDot:1
+41 IF '$GET(BSDR("VIEN"))
Begin DoDot:1
+42 SET BSDVAR("FORCE ADD")=1
+43 DO GETVISIT^SDECAPI4(.BSDVAR,.BSDRET)
End DoDot:1
+44 DO MSGADD(0,"Visit Attached/Created.")
+45 SET BSDVSTN=$ORDER(BSDRET(0))
+46 ; quit if no visit
IF '$GET(BSDVSTN)
SET MAW="S $ZE=""BSDV NO VISIT CREATED"" D ^ZTER"
XECUTE MAW
KILL MAW
QUIT
+47 ; set to selected visit var
IF $GET(BSDR("VIEN"))
SET BSDVSTN=BSDR("VIEN")
+48 ; -- add provider to visit
+49 ;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
+50 KILL SDEC
+51 SET SDEC("PRO")=BSDPROV
+52 SET SDEC("PAT")=DFN
+53 SET SDEC("VST")=BSDVSTN
+54 SET SDEC("TMP")="[SDECALVR 9000010.06 (ADD)]"
+55 SET SDEC("TPS")="P"
+56 SET SDEC("TOA")=""
+57 SET SDEC("CDT")=$GET(BSDVAR("CDT"))
+58 DO VPROV^SDECALVR(.SDEC)
+59 DO MSGADD(0,"Provider added to visit.")
End DoDot:1
+60 ;DO NOT KILL BSDVSTN, BSDVCN OR BSDOPT; KILLED AT END OF EVT DRIVER
VSTEND DO EN1^SDECEKL
DO EN2^SDECEKL
KILL SDECALVR,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 ;I $$GET1^DIQ(9009017.2,+BSDCLN,.09)'="YES" Q ;don't create visit
+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 QUIT
+22 ;
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 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^SDECU(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 ;I '$D(^APCDSITE(+FAC)) S 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 service category
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 check-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 ; if visit already has provider, edit it
+10 NEW DA,DIE,DR
+11 SET DA=$ORDER(^AUPNVPRV("AD",AUPNVSIT,0))
IF DA
Begin DoDot:1
+12 LOCK +^AUPNVPRV(AUPNVSIT):10
if '$TEST
QUIT
+13 SET DIE=9000010.06
SET DR=".01"
DO ^DIE
+14 LOCK -^AUPNVPRV(AUPNVSIT)
End DoDot:1
QUIT
+15 ; else, add v provider entry
+16 NEW VPROV
SET VPROV=$$PROV(BSDCLN)
IF VPROV>0
Begin DoDot:1
+17 NEW APCDALVR
+18 SET APCDALVR("APCDTPRO")="`"_VPROV
+19 SET APCDALVR("APCDPAT")=DFN
+20 SET APCDALVR("APCDVSIT")=AUPNVSIT
+21 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
+22 SET APCDALVR("APCDTPS")="P"
SET APCDALVR("APCDTOA")=""
+23 DO ^SDECALVR
+24 DO MSGADD(0,"Provider added to visit.")
End DoDot:1
+25 QUIT
+26 ;
PROVUPD ; will update provider on visit that was created earlier
+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
LOCK +^AUPNVPRV(PRIM):10
IF $TEST
SET DIE=9000010.06
SET DA=PRIM
SET DR=".04///S"
DO ^DIE
LOCK -^AUPNVPRV(PRIM)
+15 ;
+16 ; 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 ;D ^APCDALVR
+24 DO ^SDECALVR
+25 DO MSGADD(0,"Provider added to visit.")
+26 QUIT
+27 ;
HOSLUPD ; update hospital location on visit
+1 NEW DIE,DA,DR
+2 LOCK +^AUPNVSIT(BSDVSTN):10
+3 if '$TEST
QUIT
+4 SET DIE="^AUPNVSIT("
SET DA=BSDVSTN
SET DR=".22///`"_BSDCLN
+5 DO ^DIE
+6 LOCK -^AUPNVSIT(BSDVSTN)
+7 QUIT
+8 ;
SETVAR ; 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
+13 ;
EN1 ;CLEANUP
+1 ;
+2 KILL Y
+3 KILL AICDHLIM,XTLKHLIM
+4 KILL APCDCAT,APCDCLN,APCDDATE,APCDLOC,APCDTIME,APCDTYPE,APCDVSIT,APCDLOOK,APCDTPCC,APCDTACC,APCDFV,APCDAX,APCDAL,APCDNOK,APCDEQX,APCDMOD,APCDMPQ,APCDTVST,APCDTLOC,APCDTTYP,APCDTCAT,APCDTCLN,APCDEXIT,APCDOLOC
+5 KILL APCDTBP,APCDPVL,APCDAPPT,APCDEVM,APCDCODT,APCDLS,APCDVELG,APCDHL,APCDOPT,APCDPROT,APCDAPDT
+6 KILL APCDPAT,APCDDOB,APCDSEX,APCDDOD,APCDRV
+7 ;,AUPNLK("INAC")
KILL AUPNDOB,AUPNDOD,AUPNPAT,AUPNSEX,AUPNDAYS,AUPNVSIT
+8 KILL APCDLPAT,APCDLDAT,APCDLVST,APCDMNE,APCDNOCL,APCDNOXV,APCDAMN
+9 KILL APCDAPP,APCDBEEP,APCDDUZ,APCDDUZ2,APCDFLG,APCDL,APCDMODE,APCDOCAT,APCDODAT,APCDOTYP,APCDOVRR,APCDPVC,APCDTPLT,APCDVLK,APCDX,APCDENV,APCDEMF,APCDEIN,APCD,APCDNOXV
+10 QUIT
EN2 ;CLEANUP
+1 ;I '$D(APMFMENU) K AUPNLK("ALL")
+2 KILL APCDPARM,APCDNRV,APCDRVON,APCDRVOF,APCDSITE,APCDTRM,APCDDEFL,APCDDEFS,APCDDEFC,APCDDEFT
+3 QUIT
