BSDAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; [ 03/08/2004 10:36 AM ]
;;5.3;PIMS;**1002,1003,1006,1010,1012**;MAY 28, 2004
;IHS/ITSC/LJF 12/23/2004 PATCH 1002 removed PEP from CHECKIN entry point
; 04/22/2005 PATCH 1003 added code to handle call from BSDAPI4
;IHS/OIT/LJF 10/18/2006 PATCH 1006 now allow 240 minute appts as DD does
;cmi/anch/maw 10/20/2008 PATCH 1010 RQMT69 added FUTURE PEP function to return whether patient has a future appointment
;cmi/flag/maw 02/18/2010 PATCH 1012 added check of data in DPT node when cancelling an appointment
;
MAKE(BSDR) ;PEP; call to store appt made
;
; Make call using: S ERR=$$MAKE^BSDAPI(.ARRAY)
;
; Input Array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
; BSDR("ADT") = appointment date and time
; BSDR("LEN") = appointment length in minutes (5-120)
; BSDR("OI") = reason for appt - up to 150 characters
; BSDR("USR") = user who made appt
;
;Output: error status and message
; = 0 or null: everything okay
; = 1^message: error and reason
;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
;
;IHS/OIT/LJF 10/18/2006 PATCH 1006 DD now allows 240 minutes
;I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>120) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'="C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT")
;
NEW DIC,DA,Y,X,DD,DO,DLAYGO
;
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)="C" D
. ; "un-cancel" existing appt in file 2
. N BSDXFDA,BSDXIENS,BSDXMSG
. S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
. S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
. S BSDXFDA(2.98,BSDXIENS,"3")=""
. S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
. S BSDXFDA(2.98,BSDXIENS,"9.5")=9
. S BSDXFDA(2.98,BSDXIENS,"14")=""
. S BSDXFDA(2.98,BSDXIENS,"15")=""
. S BSDXFDA(2.98,BSDXIENS,"16")=""
. S BSDXFDA(2.98,BSDXIENS,"19")=""
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
. D FILE^DIE("","BSDXFDA","BSDXMSG")
. N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
;E D I Y<1 Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") ;cmi/maw 9/9/2008 orig line PATCH 1010
E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") ;cmi/maw 9/9/2008 new line patch 1010
. ; add appt to file 2
. ;cmi/maw 9/9/2008 changed call to silent server call PATCH 1010
. N BSDXFDA,BSDXIENS,BSDXMSG
. S BSDXIENS="?+2,"_BSDR("PAT")_","
. S BSDXIENS(2)=BSDR("ADT")
. S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
. S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
. S BSDXFDA(2.98,BSDXIENS,"9.5")=9
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
. D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
. ;S DIC="^DPT("_BSDR("PAT")_",""S"",",DA(1)=BSDR("PAT"),X=BSDR("CLN") ;cmi/maw 9/9/2008 orig line
. ;S DIC("DR")="9///"_BSDR("TYP")_";9.5///9;20///"_$$NOW^XLFDT ;cmi/maw 9/9/2008 orig line
. ;S DIC("P")="2.98P",DIC(0)="L",DLAYGO=2.98,DINUM=BSDR("ADT") ;cmi/maw 9/9/2008 orig line
. ;K DD,DO ;cmi/maw 9/9/2008 orig line
. ;D FILE^DICN ;cmi/maw 9/9/2008 orig line
;
;
; add appt to file 44
K DIC,DA,X,Y,DLAYGO,DD,DO
I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
. S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
. S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
. S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
;
K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$$NOW^XLFDT ;cmi/maw 9/19/2008 orig line
S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7////"_BSDR("USR")_";8////"_$$NOW^XLFDT ;cmi/maw 9/19/2008 mod line PATCH 1010
S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
D FILE^DICN
;
; call event driver
NEW DFN,SDT,SDCL,SDDA,SDMODE
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
S SDDA=$$SCIEN^BSDU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
Q 0
;
CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
; PATCH 1002 - entry point no longer public; other apps must call GETVISIT^BSDAPI4
;
; Make call by using: S ERR=$$CHECKIN^BSDAPI(.ARRAY)
;
; Input array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("ADT") = appt date/time
; BSDR("CDT") = checkin date/time
; BSDR("USR") = checkin user
; BSDR("OPT") = option used to create visit (optional)
;
;IHS/ITSC/LJF 4/22/2005 PATCH 1003 new variable sent from BSDAPI4
; BSDR("VIEN") = visit IEN (sent if new visit is NOT to be created)
;
; variables to create visit under event driver
; BSDR("CC") = clinic code for creating visit - optional
; BSDR("PRV") = visit provider - pointer to file 200
;
; Output value -
; = 0 means everything worked
; = 1^message means error with reason message
;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
;
; find ien for appt in file 44
NEW IEN,DIE,DA,DR
S IEN=$$SCIEN^BSDU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
;
; remember before status
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
;
; set checkin
S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
D ^DIE
;
; set after status
S SDDA=$$SCIEN^BSDU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
;
;IHS/ITSC/LJF 4/22/2005 PATCH 1003 set visit variable if not creating new visit
; event driver kills variable after all protocols run
I $G(BSDR("VIEN")) S BSDVSTN=BSDR("VIEN")
;
; call event driver
D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
Q 0
;
CANCEL(BSDR) ;PEP; called to cancel appt
;
; Make call using: S ERR=$$CANCEL^BSDAPI(.ARRAY)
;
; Input Array -
; BSDR("PAT") = ien of patient in file 2
; BSDR("CLN") = ien of clinic in file 44
; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
; BSDR("ADT") = appointment date and time
; BSDR("CDT") = cancel date and time
; BSDR("USR") = user who canceled appt
; BSDR("CR") = cancel reason - pointer to file 409.2
; BSDR("NOT") = cancel remarks - optional notes to 160 characters
;
;Output: error status and message
; = 0 or null: everything okay
; = 1^message: error and reason
;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
;
NEW IEN,DIE,DA,DR
S IEN=$$SCIEN^BSDU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
;
I $$CI^BSDU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
;
; remember before status
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
;
; get user who made appt and date appt made from ^SC
; because data in ^SC will be deleted
NEW USER,DATE
S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
;
; update file 2 info
I $D(^DPT(DFN,"S",SDT)) D ;cmi/maw 02/18/2010 allows cancellation to continue if DPT node missing
. NEW DIE,DA,DR
. S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
. S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
. S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
. D ^DIE
;
; delete data in ^SC
NEW DIK,DA
S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
D ^DIK
;
; call event driver
D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
Q 0
;
FUTURE(BSDPAT) ;PEP - PATCH 1010 RQMT69 API that returns 1 if patient has a future appointment or 0 if not DFN is passed in
N BSDDA,BSDFUT
S BSDFUT=0
S BSDDA=0 F S BSDDA=$O(^DPT(BSDPAT,"S",BSDDA)) Q:'BSDDA D
. I BSDDA>DT S BSDFUT=1
Q $G(BSDFUT)
;
BSDAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; [ 03/08/2004 10:36 AM ]
+1 ;;5.3;PIMS;**1002,1003,1006,1010,1012**;MAY 28, 2004
+2 ;IHS/ITSC/LJF 12/23/2004 PATCH 1002 removed PEP from CHECKIN entry point
+3 ; 04/22/2005 PATCH 1003 added code to handle call from BSDAPI4
+4 ;IHS/OIT/LJF 10/18/2006 PATCH 1006 now allow 240 minute appts as DD does
+5 ;cmi/anch/maw 10/20/2008 PATCH 1010 RQMT69 added FUTURE PEP function to return whether patient has a future appointment
+6 ;cmi/flag/maw 02/18/2010 PATCH 1012 added check of data in DPT node when cancelling an appointment
+7 ;
MAKE(BSDR) ;PEP; call to store appt made
+1 ;
+2 ; Make call using: S ERR=$$MAKE^BSDAPI(.ARRAY)
+3 ;
+4 ; Input Array -
+5 ; BSDR("PAT") = ien of patient in file 2
+6 ; BSDR("CLN") = ien of clinic in file 44
+7 ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
+8 ; BSDR("ADT") = appointment date and time
+9 ; BSDR("LEN") = appointment length in minutes (5-120)
+10 ; BSDR("OI") = reason for appt - up to 150 characters
+11 ; BSDR("USR") = user who made appt
+12 ;
+13 ;Output: error status and message
+14 ; = 0 or null: everything okay
+15 ; = 1^message: error and reason
+16 ;
+17 IF '$DATA(^DPT(+$GET(BSDR("PAT")),0))
QUIT 1_U_"Patient not on file: "_$GET(BSDR("PAT"))
+18 IF '$DATA(^SC(+$GET(BSDR("CLN")),0))
QUIT 1_U_"Clinic not on file: "_$GET(BSDR("CLN"))
+19 IF ($GET(BSDR("TYP"))<3)!($GET(BSDR("TYP"))>4)
QUIT 1_U_"Appt Type error: "_$GET(BSDR("TYP"))
+20 ;remove seconds
IF $GET(BSDR("ADT"))
SET BSDR("ADT")=+$EXTRACT(BSDR("ADT"),1,12)
+21 IF $GET(BSDR("ADT"))'?7N1".".4N
QUIT 1_U_"Appt Date/Time error: "_$GET(BSDR("ADT"))
+22 ;
+23 ;IHS/OIT/LJF 10/18/2006 PATCH 1006 DD now allows 240 minutes
+24 ;I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>120) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
+25 IF ($GET(BSDR("LEN"))<5)!($GET(BSDR("LEN"))>240)
QUIT 1_U_"Appt Length error: "_$GET(BSDR("LEN"))
+26 IF '$DATA(^VA(200,+$GET(BSDR("USR")),0))
QUIT 1_U_"User Who Made Appt Error: "_$GET(BSDR("USR"))
+27 IF $DATA(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0))
IF $PIECE(^(0),U,2)'="C"
QUIT 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT")
+28 ;
+29 NEW DIC,DA,Y,X,DD,DO,DLAYGO
+30 ;
+31 IF $DATA(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0))
IF $PIECE(^(0),U,2)="C"
Begin DoDot:1
+32 ; "un-cancel" existing appt in file 2
+33 NEW BSDXFDA,BSDXIENS,BSDXMSG
+34 SET BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
+35 SET BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
+36 SET BSDXFDA(2.98,BSDXIENS,"3")=""
+37 SET BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
+38 SET BSDXFDA(2.98,BSDXIENS,"9.5")=9
+39 SET BSDXFDA(2.98,BSDXIENS,"14")=""
+40 SET BSDXFDA(2.98,BSDXIENS,"15")=""
+41 SET BSDXFDA(2.98,BSDXIENS,"16")=""
+42 SET BSDXFDA(2.98,BSDXIENS,"19")=""
+43 SET BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
+44 DO FILE^DIE("","BSDXFDA","BSDXMSG")
+45 NEW BSDXTEMP
SET BSDXTEMP=$GET(BSDXMSG)
End DoDot:1
+46 ;E D I Y<1 Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") ;cmi/maw 9/9/2008 orig line PATCH 1010
+47 ;cmi/maw 9/9/2008 new line patch 1010
IF '$TEST
Begin DoDot:1
+48 ; add appt to file 2
+49 ;cmi/maw 9/9/2008 changed call to silent server call PATCH 1010
+50 NEW BSDXFDA,BSDXIENS,BSDXMSG
+51 SET BSDXIENS="?+2,"_BSDR("PAT")_","
+52 SET BSDXIENS(2)=BSDR("ADT")
+53 SET BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
+54 SET BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
+55 SET BSDXFDA(2.98,BSDXIENS,"9.5")=9
+56 SET BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
+57 DO UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
+58 ;S DIC="^DPT("_BSDR("PAT")_",""S"",",DA(1)=BSDR("PAT"),X=BSDR("CLN") ;cmi/maw 9/9/2008 orig line
+59 ;S DIC("DR")="9///"_BSDR("TYP")_";9.5///9;20///"_$$NOW^XLFDT ;cmi/maw 9/9/2008 orig line
+60 ;S DIC("P")="2.98P",DIC(0)="L",DLAYGO=2.98,DINUM=BSDR("ADT") ;cmi/maw 9/9/2008 orig line
+61 ;K DD,DO ;cmi/maw 9/9/2008 orig line
+62 ;D FILE^DICN ;cmi/maw 9/9/2008 orig line
End DoDot:1
IF $GET(BSDXERR(1))
QUIT 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
+63 ;
+64 ;
+65 ; add appt to file 44
+66 KILL DIC,DA,X,Y,DLAYGO,DD,DO
+67 IF '$DATA(^SC(BSDR("CLN"),"S",0))
SET ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
+68 IF '$DATA(^SC(BSDR("CLN"),"S",BSDR("ADT"),0))
Begin DoDot:1
+69 SET DIC="^SC("_BSDR("CLN")_",""S"","
SET DA(1)=BSDR("CLN")
SET (X,DINUM)=BSDR("ADT")
+70 SET DIC("P")="44.001DA"
SET DIC(0)="L"
SET DLAYGO=44.001
+71 SET Y=1
IF '$DATA(@(DIC_X_")"))
DO FILE^DICN
End DoDot:1
IF Y<1
QUIT 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
+72 ;
+73 KILL DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
+74 SET DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
+75 SET DA(2)=BSDR("CLN")
SET DA(1)=BSDR("ADT")
SET X=BSDR("PAT")
+76 ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$$NOW^XLFDT ;cmi/maw 9/19/2008 orig line
+77 ;cmi/maw 9/19/2008 mod line PATCH 1010
SET DIC("DR")="1///"_BSDR("LEN")_";3///"_$EXTRACT($GET(BSDR("OI")),1,150)_";7////"_BSDR("USR")_";8////"_$$NOW^XLFDT
+78 SET DIC("P")="44.003PA"
SET DIC(0)="L"
SET DLAYGO=44.003
+79 DO FILE^DICN
+80 ;
+81 ; call event driver
+82 NEW DFN,SDT,SDCL,SDDA,SDMODE
+83 SET DFN=BSDR("PAT")
SET SDT=BSDR("ADT")
SET SDCL=BSDR("CLN")
SET SDMODE=2
+84 SET SDDA=$$SCIEN^BSDU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+85 DO MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
+86 QUIT 0
+87 ;
CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
+1 ; PATCH 1002 - entry point no longer public; other apps must call GETVISIT^BSDAPI4
+2 ;
+3 ; Make call by using: S ERR=$$CHECKIN^BSDAPI(.ARRAY)
+4 ;
+5 ; Input array -
+6 ; BSDR("PAT") = ien of patient in file 2
+7 ; BSDR("CLN") = ien of clinic in file 44
+8 ; BSDR("ADT") = appt date/time
+9 ; BSDR("CDT") = checkin date/time
+10 ; BSDR("USR") = checkin user
+11 ; BSDR("OPT") = option used to create visit (optional)
+12 ;
+13 ;IHS/ITSC/LJF 4/22/2005 PATCH 1003 new variable sent from BSDAPI4
+14 ; BSDR("VIEN") = visit IEN (sent if new visit is NOT to be created)
+15 ;
+16 ; variables to create visit under event driver
+17 ; BSDR("CC") = clinic code for creating visit - optional
+18 ; BSDR("PRV") = visit provider - pointer to file 200
+19 ;
+20 ; Output value -
+21 ; = 0 means everything worked
+22 ; = 1^message means error with reason message
+23 ;
+24 IF '$DATA(^DPT(+$GET(BSDR("PAT")),0))
QUIT 1_U_"Patient not on file: "_$GET(BSDR("PAT"))
+25 IF '$DATA(^SC(+$GET(BSDR("CLN")),0))
QUIT 1_U_"Clinic not on file: "_$GET(BSDR("CLN"))
+26 ;remove seconds
IF $GET(BSDR("ADT"))
SET BSDR("ADT")=+$EXTRACT(BSDR("ADT"),1,12)
+27 IF $GET(BSDR("ADT"))'?7N1".".4N
QUIT 1_U_"Appt Date/Time error: "_$GET(BSDR("ADT"))
+28 ;remove seconds
IF $GET(BSDR("CDT"))
SET BSDR("CDT")=+$EXTRACT(BSDR("CDT"),1,12)
+29 IF $GET(BSDR("CDT"))'?7N1".".4N
QUIT 1_U_"Checkin Date/Time error: "_$GET(BSDR("CDT"))
+30 IF '$DATA(^VA(200,+$GET(BSDR("USR")),0))
QUIT 1_U_"User Who Made Appt Error: "_$GET(BSDR("USR"))
+31 ;
+32 ; find ien for appt in file 44
+33 NEW IEN,DIE,DA,DR
+34 SET IEN=$$SCIEN^BSDU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+35 IF 'IEN
QUIT 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
+36 ;
+37 ; remember before status
+38 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
+39 SET DFN=BSDR("PAT")
SET SDT=BSDR("ADT")
SET SDCL=BSDR("CLN")
SET SDMODE=2
SET SDDA=IEN
+40 SET SDCIHDL=$$HANDLE^SDAMEVT(1)
SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+41 DO BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+42 ;
+43 ; set checkin
+44 SET DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
+45 SET DA(2)=BSDR("CLN")
SET DA(1)=BSDR("ADT")
SET DA=IEN
+46 SET DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
+47 DO ^DIE
+48 ;
+49 ; set after status
+50 SET SDDA=$$SCIEN^BSDU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+51 SET SDCIHDL=$$HANDLE^SDAMEVT(1)
SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+52 DO AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+53 ;
+54 ;IHS/ITSC/LJF 4/22/2005 PATCH 1003 set visit variable if not creating new visit
+55 ; event driver kills variable after all protocols run
+56 IF $GET(BSDR("VIEN"))
SET BSDVSTN=BSDR("VIEN")
+57 ;
+58 ; call event driver
+59 DO EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
+60 QUIT 0
+61 ;
CANCEL(BSDR) ;PEP; called to cancel appt
+1 ;
+2 ; Make call using: S ERR=$$CANCEL^BSDAPI(.ARRAY)
+3 ;
+4 ; Input Array -
+5 ; BSDR("PAT") = ien of patient in file 2
+6 ; BSDR("CLN") = ien of clinic in file 44
+7 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
+8 ; BSDR("ADT") = appointment date and time
+9 ; BSDR("CDT") = cancel date and time
+10 ; BSDR("USR") = user who canceled appt
+11 ; BSDR("CR") = cancel reason - pointer to file 409.2
+12 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
+13 ;
+14 ;Output: error status and message
+15 ; = 0 or null: everything okay
+16 ; = 1^message: error and reason
+17 ;
+18 IF '$DATA(^DPT(+$GET(BSDR("PAT")),0))
QUIT 1_U_"Patient not on file: "_$GET(BSDR("PAT"))
+19 IF '$DATA(^SC(+$GET(BSDR("CLN")),0))
QUIT 1_U_"Clinic not on file: "_$GET(BSDR("CLN"))
+20 IF ($GET(BSDR("TYP"))'="C")
IF ($GET(BSDR("TYP"))'="PC")
QUIT 1_U_"Cancel Status error: "_$GET(BSDR("TYP"))
+21 ;remove seconds
IF $GET(BSDR("ADT"))
SET BSDR("ADT")=+$EXTRACT(BSDR("ADT"),1,12)
+22 IF $GET(BSDR("ADT"))'?7N1".".4N
QUIT 1_U_"Appt Date/Time error: "_$GET(BSDR("ADT"))
+23 ;remove seconds
IF $GET(BSDR("CDT"))
SET BSDR("CDT")=+$EXTRACT(BSDR("CDT"),1,12)
+24 IF $GET(BSDR("CDT"))'?7N1".".4N
QUIT 1_U_"Cancel Date/Time error: "_$GET(BSDR("CDT"))
+25 IF '$DATA(^VA(200,+$GET(BSDR("USR")),0))
QUIT 1_U_"User Who Canceled Appt Error: "_$GET(BSDR("USR"))
+26 IF '$DATA(^SD(409.2,+$GET(BSDR("CR"))))
QUIT 1_U_"Cancel Reason error: "_$GET(BSDR("CR"))
+27 ;
+28 NEW IEN,DIE,DA,DR
+29 SET IEN=$$SCIEN^BSDU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+30 IF 'IEN
QUIT 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
+31 ;
+32 IF $$CI^BSDU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN)
QUIT 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
+33 ;
+34 ; remember before status
+35 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
+36 SET DFN=BSDR("PAT")
SET SDT=BSDR("ADT")
SET SDCL=BSDR("CLN")
SET SDMODE=2
SET SDDA=IEN
+37 SET SDCPHDL=$$HANDLE^SDAMEVT(1)
SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+38 DO BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
+39 ;
+40 ; get user who made appt and date appt made from ^SC
+41 ; because data in ^SC will be deleted
+42 NEW USER,DATE
+43 SET USER=$PIECE($GET(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
+44 SET DATE=$PIECE($GET(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
+45 ;
+46 ; update file 2 info
+47 ;cmi/maw 02/18/2010 allows cancellation to continue if DPT node missing
IF $DATA(^DPT(DFN,"S",SDT))
Begin DoDot:1
+48 NEW DIE,DA,DR
+49 SET DIE="^DPT("_DFN_",""S"","
SET DA(1)=DFN
SET DA=SDT
+50 SET DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
+51 IF $GET(BSDR("NOT"))]""
SET DR=DR_";17///"_$EXTRACT(BSDR("NOT"),1,160)
+52 DO ^DIE
End DoDot:1
+53 ;
+54 ; delete data in ^SC
+55 NEW DIK,DA
+56 SET DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
+57 SET DA(2)=BSDR("CLN")
SET DA(1)=BSDR("ADT")
SET DA=IEN
+58 DO ^DIK
+59 ;
+60 ; call event driver
+61 DO CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
+62 QUIT 0
+63 ;
FUTURE(BSDPAT) ;PEP - PATCH 1010 RQMT69 API that returns 1 if patient has a future appointment or 0 if not DFN is passed in
+1 NEW BSDDA,BSDFUT
+2 SET BSDFUT=0
+3 SET BSDDA=0
FOR
SET BSDDA=$ORDER(^DPT(BSDPAT,"S",BSDDA))
IF 'BSDDA
QUIT
Begin DoDot:1
+4 IF BSDDA>DT
SET BSDFUT=1
End DoDot:1
+5 QUIT $GET(BSDFUT)
+6 ;
