ASDV ; IHS/ANMC/LJF - CREATE VISIT AT CHECK-IN ; [ 12/01/2000 11:10 AM ]
;;5.0;IHS SCHEDULING;**5,7**;MAR 25, 1999
;PATCH #5: added this routine
;PATCH #7: requiring provider is based on clinic parameter
;
CHKIN(ASDCLN,ASDDT,APTN,DFN) ;EP; -- ask visit related check-in questions
; called by SDI during check-in process
; user interface for 2 questions (clinic code and provider)
; Input variables:
; ASDCLN = clinic ien
; ASDDT = appt date/time
; APTN = ien for appt under date mutiple
; DFN = patient ien
;
Q:'$G(DFN) Q:'$G(ASDCLN) Q:'$G(ASDDT) Q:'$G(APTN)
I $P($G(^SC(+ASDCLN,9999999)),U,9)'=1 Q ;don't create visit
Q:'$G(^SC(+ASDCLN,"S",ASDDT,1,APTN,"C")) ;not checked-in
;
NEW ASDCC,ASDVP,ASDMSG
S ASDCC=$$CLNCODE(ASDCLN) ;ask clinic code
S ASDVP=$$PROV(ASDCLN) ;ask visit provider
D VISIT(ASDCLN,ASDDT,APTN,DFN,ASDCC,ASDVP,.ASDMSG) ;create visit
;
I $D(ASDMSG) D
. NEW I F I=1:1 Q:'$D(ASDMSG(I)) D MSG($P(ASDMSG(I),U,2),1,0)
Q
;
VISIT(ASDCLN,ASDDT,APTN,DFN,ASDCC,ASDPROV,ASDMSG) ;PEP; -- create visit
; called by CHKIN subroutine above and by applications where
; all data is already known
; assumes calling routine has checked that patient is checked in
; silent update to database; no user interface
; Input variables:
; ASDCLN = clinic ien
; ASDDT = appt date/time
; APTN = ien for appt under date mutiple
; DFN = patient ien
; ASDCC = clinic code ien
; ASDPROV = visit provider ien
; ASDMSG = 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(ASDCLN) Q:'$G(ASDDT) Q:'$G(APTN) Q:'$G(DFN)
Q:'$G(ASDCC) ;Q:'$G(ASDPROV) ;PATCH 7
I $P($G(^SC(+ASDCLN,9999999)),U,9)'=1 Q ;create visit turned off
;
; send data to pyxis
NEW X S X="VEFSPOBS" X ^%ZOSF("TEST") I $T D
. S X=$P($G(^SC(+ASDCLN,9999999)),U,13) I X]"" D AMB^VEFSPOBS(X)
;
; -- set up visit variables
K APCDALVR
S APCDALVR("APCDLOC")=$$FAC(ASDCLN) ;facility
I 'APCDALVR("APCDLOC") D Q
. D MSGADD(1,"Cannot create visit; can't find correct PCC facility.")
. D VSTEND
S APCDALVR("APCDPAT")=DFN ;patient
S APCDALVR("APCDTYPE")=$$VALI^XBDIQ1(9001001.2,APCDALVR("APCDLOC"),.11)
S APCDALVR("APCDCAT")=$$SERCAT(ASDCLN,DFN) ;srv cat
S APCDALVR("APCDDATE")=$G(^SC(ASDCLN,"S",ASDDT,1,APTN,"C")) ;chkin dt
S APCDALVR("APCDCLN")="`"_ASDCC ;clinic code w/`
S APCDALVR("APCDHL")=+ASDCLN ;clinic name
S X=$O(^DIC(19,"B","SD IHS PCC LINK",0))
I X S APCDALVR("APCDOPT")=X ;option used
S APCDALVR("APCDAPDT")=ASDDT ;appt date
S APCDALVR("APCDAPPT")=$S($P(^DPT(DFN,"S",ASDDT,0),U,7)=3:"A",$P(^DPT(DFN,"S",ASDDT,0),U,7)=4:"W",1:"U") ;walk-in vs appt
S APCDALVR("APCDADD")=1 ;force add
;
; -- create visit
N %DT ;per Lori - %DT(0) set somewhere in scheduling and prevents creation of visit for current or future dates
D ^APCDALV
I '$G(APCDALVR("APCDVSIT")) D D VSTEND Q
. D MSGADD(2,"VISIT ERROR, Please notify your supervisor!")
D MSGADD(0,"Visit Created.")
S ASDVST=APCDALVR("APCDVSIT")
;
; -- add provider to visit
I ASDPROV D ;add provider only if passed;PATCH 7
. K APCDALVR
. S APCDALVR("APCDTPRO")="`"_ASDPROV
. S APCDALVR("APCDPAT")=DFN
. S APCDALVR("APCDVSIT")=ASDVST
. 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
I $T(VCN^AUPNVSIT)]"" S ASDVCN=$$VCN^AUPNVSIT(ASDVST,1)
;
; -- call to print PCC Encounter Form
;ADD CODE HERE
;
VSTEND D EN1^APCDEKL,EN2^APCDEKL K APCDALVR,ASDVST,X
Q
;
VDATE(ASDCLN,ASDDT,APTN,DFN,ASDCKO,ASDMSG) ;EP;if new time entered, update visit
; called by SDI if check-in time was changed
; silent update to database; no user interface
; Input variables:
; ASDCLN = clinic ien
; ASSDT = appt date & time
; APTN = ien for appt under date multiple
; DFN = Patient ien
; ASDCKO = old check-in date/time
; ASDMSG = called by reference, upon exit contains user msgs
;
I $P($G(^SC(+ASDCLN,9999999)),U,9)'=1 Q ;create visit turned off
NEW APCDVSIT,ASDCK
;
; find visit based on old check-in time
S APCDVSIT=$O(^AUPNVSIT("AA",DFN,$$RDT(ASDCKO),0)) Q:'APCDVSIT
I $O(^AUPNVSIT("AA",DFN,$$RDT(ASDCKO),APCDVSIT)) D MSGADD(4,"More than 1 visit at same date/time; must be updated manually.") Q ;PATCH 7
;
; get new check-in time
;S ASDCK=$G(^SC(ASDCLN,"S",ASDDT,1,APTN,"C")) Q:'ASDCK ;PATCH 7
S ASDCK=$G(^SC(ASDCLN,"S",ASDDT,1,APTN,"C")) ;PATCH 7
I 'ASDCK S APCDVDLT=APCDVSIT I $$GET1^DIQ(9000010,APCDVSIT,.09)<2 NEW I D EN^APCDVDLT D MSGADD(0,"Visit Deleted.") Q ;PATCH 7 delete visit if check-in time deleted and visit has less than 2 dep entries
;
;if visit date/time does NOT match new check-in date/time, modify it
I $$VALI^XBDIQ1(9000010,APCDVSIT,.01)'=ASDCK D
. S APCDCVDT("VISIT DFN")=APCDVSIT
. S APCDCVDT("VISIT DATE/TIME")=ASDCK
. 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
;
;
; subroutines called by entry points above
;
RDT(X) ; -- reverse date
Q 9999999-$P(X,".")_"."_$P(X,".",2)
;
CLNCODE(CLINIC) ; -- asks user for clinic code
NEW Y,DIR,CODE
F Q:$G(Y)>0 D
. S DIR(0)="P^40.7:EMZQ",DIR("A")="CLINIC CODE for VISIT"
. S CODE=$$VAL^XBDIQ1(40.7,+$$VALI^XBDIQ1(44,CLINIC,8),1) ;code #
. ;do not set default if multiple clinic codes used in clinic
. I CODE,$$VAL^XBDIQ1(44,CLINIC,9999999.14)'="YES" S DIR("B")=CODE
. S DIR("?")="This is required. Please try again"
. D ^DIR
Q +Y
;
PROV(CLINIC) ; - asks user for visit provider
NEW DIC,X,Y
F Q:$G(Y)>0 D
. S DIC=200,DIC(0)="AMEQZ",DIC("A")="VISIT PROVIDER: "
. S DIC("B")=$$VAL^XBDIQ1(200,+$$VALI^XBDIQ1(44,CLINIC,9999999.8),.01)
. I DIC("B")="" K DIC("B")
. S DIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))"
. D ^DIC K DIC
. I Y<1,$$GET1^DIQ(44,CLINIC,9999999.15)'="YES" S Y="1^QUIT" Q ;not required;PATCH 7
. I Y<1 D MSG("This is required. Please try again.",1,0)
I $P(Y,U,2)="QUIT" Q 0 ;not required;PATCH 7
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
NEW I
S I=$O(ASDMSG(""),-1)+1 ;get next subscript
S ASDMSG(I)=ERROR_U_STRING
Q
;
MSG(DATA,PRE,POST) ; -- writes line to device
NEW 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
NEW FAC
S FAC=$$VALI^XBDIQ1(44,CLINIC,3)
I 'FAC S FAC=$$VALI^XBDIQ1(40.8,+$$VALI^XBDIQ1(44,ASDCLN,3.5),.07)
I 'FAC S FAC=$G(DUZ(2))
I '$D(^APCDSITE(+FAC)) S FAC=0
Q FAC
;
SERCAT(CLINIC,PAT) ; -- returns service category for visit
NEW CAT,CLNCAT
S CLNCAT=$$VALI^XBDIQ1(44,CLINIC,9999999.12) ;clinic's ser cat
S CAT=$S($G(^DPT(PAT,.1))]"":"I",CLNCAT]"":CLNCAT,1:"A") ;chk if inpt
Q CAT
ASDV ; IHS/ANMC/LJF - CREATE VISIT AT CHECK-IN ; [ 12/01/2000 11:10 AM ]
+1 ;;5.0;IHS SCHEDULING;**5,7**;MAR 25, 1999
+2 ;PATCH #5: added this routine
+3 ;PATCH #7: requiring provider is based on clinic parameter
+4 ;
CHKIN(ASDCLN,ASDDT,APTN,DFN) ;EP; -- ask visit related check-in questions
+1 ; called by SDI during check-in process
+2 ; user interface for 2 questions (clinic code and provider)
+3 ; Input variables:
+4 ; ASDCLN = clinic ien
+5 ; ASDDT = appt date/time
+6 ; APTN = ien for appt under date mutiple
+7 ; DFN = patient ien
+8 ;
+9 IF '$GET(DFN)
QUIT
IF '$GET(ASDCLN)
QUIT
IF '$GET(ASDDT)
QUIT
IF '$GET(APTN)
QUIT
+10 ;don't create visit
IF $PIECE($GET(^SC(+ASDCLN,9999999)),U,9)'=1
QUIT
+11 ;not checked-in
IF '$GET(^SC(+ASDCLN,"S",ASDDT,1,APTN,"C"))
QUIT
+12 ;
+13 NEW ASDCC,ASDVP,ASDMSG
+14 ;ask clinic code
SET ASDCC=$$CLNCODE(ASDCLN)
+15 ;ask visit provider
SET ASDVP=$$PROV(ASDCLN)
+16 ;create visit
DO VISIT(ASDCLN,ASDDT,APTN,DFN,ASDCC,ASDVP,.ASDMSG)
+17 ;
+18 IF $DATA(ASDMSG)
Begin DoDot:1
+19 NEW I
FOR I=1:1
IF '$DATA(ASDMSG(I))
QUIT
DO MSG($PIECE(ASDMSG(I),U,2),1,0)
End DoDot:1
+20 QUIT
+21 ;
VISIT(ASDCLN,ASDDT,APTN,DFN,ASDCC,ASDPROV,ASDMSG) ;PEP; -- create visit
+1 ; called by CHKIN subroutine above and by applications where
+2 ; all data is already known
+3 ; assumes calling routine has checked that patient is checked in
+4 ; silent update to database; no user interface
+5 ; Input variables:
+6 ; ASDCLN = clinic ien
+7 ; ASDDT = appt date/time
+8 ; APTN = ien for appt under date mutiple
+9 ; DFN = patient ien
+10 ; ASDCC = clinic code ien
+11 ; ASDPROV = visit provider ien
+12 ; ASDMSG = called by reference, upon exit contains user msgs
+13 ; first piece is error code; 2nd piece is message
+14 ; Error = 0 (no problems)
+15 ; 1 (problem setting visit variables)
+16 ; 2 (problem creating visit)
+17 ; 3 (problem changing visit date/time)
+18 ;
+19 IF '$GET(ASDCLN)
QUIT
IF '$GET(ASDDT)
QUIT
IF '$GET(APTN)
QUIT
IF '$GET(DFN)
QUIT
+20 ;Q:'$G(ASDPROV) ;PATCH 7
IF '$GET(ASDCC)
QUIT
+21 ;create visit turned off
IF $PIECE($GET(^SC(+ASDCLN,9999999)),U,9)'=1
QUIT
+22 ;
+23 ; send data to pyxis
+24 NEW X
SET X="VEFSPOBS"
XECUTE ^%ZOSF("TEST")
IF $TEST
Begin DoDot:1
+25 SET X=$PIECE($GET(^SC(+ASDCLN,9999999)),U,13)
IF X]""
DO AMB^VEFSPOBS(X)
End DoDot:1
+26 ;
+27 ; -- set up visit variables
+28 KILL APCDALVR
+29 ;facility
SET APCDALVR("APCDLOC")=$$FAC(ASDCLN)
+30 IF 'APCDALVR("APCDLOC")
Begin DoDot:1
+31 DO MSGADD(1,"Cannot create visit; can't find correct PCC facility.")
+32 DO VSTEND
End DoDot:1
QUIT
+33 ;patient
SET APCDALVR("APCDPAT")=DFN
+34 SET APCDALVR("APCDTYPE")=$$VALI^XBDIQ1(9001001.2,APCDALVR("APCDLOC"),.11)
+35 ;srv cat
SET APCDALVR("APCDCAT")=$$SERCAT(ASDCLN,DFN)
+36 ;chkin dt
SET APCDALVR("APCDDATE")=$GET(^SC(ASDCLN,"S",ASDDT,1,APTN,"C"))
+37 ;clinic code w/`
SET APCDALVR("APCDCLN")="`"_ASDCC
+38 ;clinic name
SET APCDALVR("APCDHL")=+ASDCLN
+39 SET X=$ORDER(^DIC(19,"B","SD IHS PCC LINK",0))
+40 ;option used
IF X
SET APCDALVR("APCDOPT")=X
+41 ;appt date
SET APCDALVR("APCDAPDT")=ASDDT
+42 ;walk-in vs appt
SET APCDALVR("APCDAPPT")=$SELECT($PIECE(^DPT(DFN,"S",ASDDT,0),U,7)=3:"A",$PIECE(^DPT(DFN,"S",ASDDT,0),U,7)=4:"W",1:"U")
+43 ;force add
SET APCDALVR("APCDADD")=1
+44 ;
+45 ; -- create visit
+46 ;per Lori - %DT(0) set somewhere in scheduling and prevents creation of visit for current or future dates
NEW %DT
+47 DO ^APCDALV
+48 IF '$GET(APCDALVR("APCDVSIT"))
Begin DoDot:1
+49 DO MSGADD(2,"VISIT ERROR, Please notify your supervisor!")
End DoDot:1
DO VSTEND
QUIT
+50 DO MSGADD(0,"Visit Created.")
+51 SET ASDVST=APCDALVR("APCDVSIT")
+52 ;
+53 ; -- add provider to visit
+54 ;add provider only if passed;PATCH 7
IF ASDPROV
Begin DoDot:1
+55 KILL APCDALVR
+56 SET APCDALVR("APCDTPRO")="`"_ASDPROV
+57 SET APCDALVR("APCDPAT")=DFN
+58 SET APCDALVR("APCDVSIT")=ASDVST
+59 SET APCDALVR("APCDATMP")="[APCDALVR 9000010.06 (ADD)]"
+60 SET APCDALVR("APCDTPS")="P"
SET APCDALVR("APCDTOA")=""
+61 DO ^APCDALVR
+62 DO MSGADD(0,"Provider added to visit.")
End DoDot:1
+63 ;
+64 ; -- create VCN and add to visit
+65 IF $TEXT(VCN^AUPNVSIT)]""
SET ASDVCN=$$VCN^AUPNVSIT(ASDVST,1)
+66 ;
+67 ; -- call to print PCC Encounter Form
+68 ;ADD CODE HERE
+69 ;
VSTEND DO EN1^APCDEKL
DO EN2^APCDEKL
KILL APCDALVR,ASDVST,X
+1 QUIT
+2 ;
VDATE(ASDCLN,ASDDT,APTN,DFN,ASDCKO,ASDMSG) ;EP;if new time entered, update visit
+1 ; called by SDI if check-in time was changed
+2 ; silent update to database; no user interface
+3 ; Input variables:
+4 ; ASDCLN = clinic ien
+5 ; ASSDT = appt date & time
+6 ; APTN = ien for appt under date multiple
+7 ; DFN = Patient ien
+8 ; ASDCKO = old check-in date/time
+9 ; ASDMSG = called by reference, upon exit contains user msgs
+10 ;
+11 ;create visit turned off
IF $PIECE($GET(^SC(+ASDCLN,9999999)),U,9)'=1
QUIT
+12 NEW APCDVSIT,ASDCK
+13 ;
+14 ; find visit based on old check-in time
+15 SET APCDVSIT=$ORDER(^AUPNVSIT("AA",DFN,$$RDT(ASDCKO),0))
IF 'APCDVSIT
QUIT
+16 ;PATCH 7
IF $ORDER(^AUPNVSIT("AA",DFN,$$RDT(ASDCKO),APCDVSIT))
DO MSGADD(4,"More than 1 visit at same date/time; must be updated manually.")
QUIT
+17 ;
+18 ; get new check-in time
+19 ;S ASDCK=$G(^SC(ASDCLN,"S",ASDDT,1,APTN,"C")) Q:'ASDCK ;PATCH 7
+20 ;PATCH 7
SET ASDCK=$GET(^SC(ASDCLN,"S",ASDDT,1,APTN,"C"))
+21 ;PATCH 7 delete visit if check-in time deleted and visit has less than 2 dep entries
IF 'ASDCK
SET APCDVDLT=APCDVSIT
IF $$GET1^DIQ(9000010,APCDVSIT,.09)<2
NEW I
DO EN^APCDVDLT
DO MSGADD(0,"Visit Deleted.")
QUIT
+22 ;
+23 ;if visit date/time does NOT match new check-in date/time, modify it
+24 IF $$VALI^XBDIQ1(9000010,APCDVSIT,.01)'=ASDCK
Begin DoDot:1
+25 SET APCDCVDT("VISIT DFN")=APCDVSIT
+26 SET APCDCVDT("VISIT DATE/TIME")=ASDCK
+27 DO ^APCDCVDT
+28 IF $DATA(APCDCVDT("ERROR FLAG"))
DO MSGADD(3,"Changing visit date/time failed. Please notify your supervisor.")
QUIT
+29 KILL APCDCVDT
+30 DO MSGADD(0,"Visit Date/Time Updated.")
End DoDot:1
+31 QUIT
+32 ;
+33 ;
+34 ; subroutines called by entry points above
+35 ;
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=$$VAL^XBDIQ1(40.7,+$$VALI^XBDIQ1(44,CLINIC,8),1)
+5 ;do not set default if multiple clinic codes used in clinic
+6 IF CODE
IF $$VAL^XBDIQ1(44,CLINIC,9999999.14)'="YES"
SET DIR("B")=CODE
+7 SET DIR("?")="This is required. Please try again"
+8 DO ^DIR
End DoDot:1
+9 QUIT +Y
+10 ;
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")=$$VAL^XBDIQ1(200,+$$VALI^XBDIQ1(44,CLINIC,9999999.8),.01)
+5 IF DIC("B")=""
KILL DIC("B")
+6 SET DIC("S")="I $D(^XUSEC(""PROVIDER"",+Y))"
+7 DO ^DIC
KILL DIC
+8 ;not required;PATCH 7
IF Y<1
IF $$GET1^DIQ(44,CLINIC,9999999.15)'="YES"
SET Y="1^QUIT"
QUIT
+9 IF Y<1
DO MSG("This is required. Please try again.",1,0)
End DoDot:1
+10 ;not required;PATCH 7
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(ASDMSG(""),-1)+1
+3 SET ASDMSG(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=$$VALI^XBDIQ1(44,CLINIC,3)
+5 IF 'FAC
SET FAC=$$VALI^XBDIQ1(40.8,+$$VALI^XBDIQ1(44,ASDCLN,3.5),.07)
+6 IF 'FAC
SET FAC=$GET(DUZ(2))
+7 IF '$DATA(^APCDSITE(+FAC))
SET FAC=0
+8 QUIT FAC
+9 ;
SERCAT(CLINIC,PAT) ; -- returns service category for visit
+1 NEW CAT,CLNCAT
+2 ;clinic's ser cat
SET CLNCAT=$$VALI^XBDIQ1(44,CLINIC,9999999.12)
+3 ;chk if inpt
SET CAT=$SELECT($GET(^DPT(PAT,.1))]"":"I",CLNCAT]"":CLNCAT,1:"A")
+4 QUIT CAT
