SDECAPI ;ALB/SAT,PC,TJB - VISTA SCHEDULING RPCS ;NOV 29, 2023@13:00
;;5.3;Scheduling;**627,694,866**;Aug 13, 1993;Build 22
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
MAKE(BSDR) ;PEP; call to store appt made
;
; Make call using: S ERR=$$MAKE^SDECAPI(.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
;
N BSDXERR
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"))'?7N1"."1N.N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) ;PWC allow any time combination of numbers #694
;
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 $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
. ; add appt to file 2
. ; call to silent server call
. 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)")
;
; 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
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^SDECU2(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
;
; 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)
;
; 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"))'?7N1"."1N.N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) ;PWC allow any time combination of numbers #694
I $G(BSDR("CDT"))'?7N1"."1N.N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT")) ;PWC allow any time combination of numbers #694
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,BSDVSTN
S IEN=$$SCIEN^SDECU2(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
N SDFDA
; S SDFDA(44.003,IEN_","_BSDR("ADT")_","_BSDR("CLN")_",",302)=BSDR("USR")
S SDFDA(44.003,IEN_","_BSDR("ADT")_","_BSDR("CLN")_",",305)=$$NOW^XLFDT()
S SDFDA(44.003,IEN_","_BSDR("ADT")_","_BSDR("CLN")_",",309)=BSDR("CDT")
D FILE^DIE("","SDFDA")
K SDFDA
; Updating 302 separately because of trigger on field 309 uses logged-in DUZ
S SDFDA(44.003,IEN_","_BSDR("ADT")_","_BSDR("CLN")_",",302)=BSDR("USR")
D FILE^DIE("","SDFDA")
;
;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^SDECU2(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)
;
; 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^SDECAPI(.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"))'?7N1"."1N.N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) ;PWC allow any time combination of numbers #694
I $G(BSDR("CDT"))'?7N1"."1N.N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT")) ;PWC allow any time combination of numbers #694
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^SDECU2(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^SDECU2(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 ; 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) ;PEPAPI 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)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECAPI 9465 printed Dec 13, 2024@02:51:39 Page 2
SDECAPI ;ALB/SAT,PC,TJB - VISTA SCHEDULING RPCS ;NOV 29, 2023@13:00
+1 ;;5.3;Scheduling;**627,694,866**;Aug 13, 1993;Build 22
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
MAKE(BSDR) ;PEP; call to store appt made
+1 ;
+2 ; Make call using: S ERR=$$MAKE^SDECAPI(.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 NEW BSDXERR
+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"))<3)!($GET(BSDR("TYP"))>4)
QUIT 1_U_"Appt Type error: "_$GET(BSDR("TYP"))
+21 ;PWC allow any time combination of numbers #694
IF $GET(BSDR("ADT"))'?7N1"."1N.N
QUIT 1_U_"Appt Date/Time error: "_$GET(BSDR("ADT"))
+22 ;
+23 IF ($GET(BSDR("LEN"))<5)!($GET(BSDR("LEN"))>240)
QUIT 1_U_"Appt Length error: "_$GET(BSDR("LEN"))
+24 IF '$DATA(^VA(200,+$GET(BSDR("USR")),0))
QUIT 1_U_"User Who Made Appt Error: "_$GET(BSDR("USR"))
+25 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")
+26 ;
+27 NEW DIC,DA,Y,X,DD,DO,DLAYGO
+28 ;
+29 IF $DATA(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0))
IF $PIECE(^(0),U,2)="C"
Begin DoDot:1
+30 ; "un-cancel" existing appt in file 2
+31 NEW BSDXFDA,BSDXIENS,BSDXMSG
+32 SET BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
+33 SET BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
+34 SET BSDXFDA(2.98,BSDXIENS,"3")=""
+35 SET BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
+36 SET BSDXFDA(2.98,BSDXIENS,"9.5")=9
+37 SET BSDXFDA(2.98,BSDXIENS,"14")=""
+38 SET BSDXFDA(2.98,BSDXIENS,"15")=""
+39 SET BSDXFDA(2.98,BSDXIENS,"16")=""
+40 SET BSDXFDA(2.98,BSDXIENS,"19")=""
+41 SET BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
+42 DO FILE^DIE("","BSDXFDA","BSDXMSG")
+43 NEW BSDXTEMP
SET BSDXTEMP=$GET(BSDXMSG)
End DoDot:1
+44 IF '$TEST
Begin DoDot:1
+45 ; add appt to file 2
+46 ; call to silent server call
+47 NEW BSDXFDA,BSDXIENS,BSDXMSG
+48 SET BSDXIENS="?+2,"_BSDR("PAT")_","
+49 SET BSDXIENS(2)=BSDR("ADT")
+50 SET BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
+51 SET BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
+52 SET BSDXFDA(2.98,BSDXIENS,"9.5")=9
+53 SET BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
+54 DO UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
End DoDot:1
IF $GET(BSDXERR(1))
QUIT 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
+55 ;
+56 ; add appt to file 44
+57 KILL DIC,DA,X,Y,DLAYGO,DD,DO
+58 IF '$DATA(^SC(BSDR("CLN"),"S",0))
SET ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
+59 IF '$DATA(^SC(BSDR("CLN"),"S",BSDR("ADT"),0))
Begin DoDot:1
+60 SET DIC="^SC("_BSDR("CLN")_",""S"","
SET DA(1)=BSDR("CLN")
SET (X,DINUM)=BSDR("ADT")
+61 SET DIC("P")="44.001DA"
SET DIC(0)="L"
SET DLAYGO=44.001
+62 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")
+63 ;
+64 KILL DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
+65 SET DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
+66 SET DA(2)=BSDR("CLN")
SET DA(1)=BSDR("ADT")
SET X=BSDR("PAT")
+67 SET DIC("DR")="1///"_BSDR("LEN")_";3///"_$EXTRACT($GET(BSDR("OI")),1,150)_";7////"_BSDR("USR")_";8////"_$$NOW^XLFDT
+68 SET DIC("P")="44.003PA"
SET DIC(0)="L"
SET DLAYGO=44.003
+69 DO FILE^DICN
+70 ;
+71 ; call event driver
+72 NEW DFN,SDT,SDCL,SDDA,SDMODE
+73 SET DFN=BSDR("PAT")
SET SDT=BSDR("ADT")
SET SDCL=BSDR("CLN")
SET SDMODE=2
+74 SET SDDA=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+75 DO MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
+76 QUIT 0
+77 ;
CHECKIN(BSDR) ;EP; call to add checkin info to appt
+1 ;
+2 ; Input array -
+3 ; BSDR("PAT") = ien of patient in file 2
+4 ; BSDR("CLN") = ien of clinic in file 44
+5 ; BSDR("ADT") = appt date/time
+6 ; BSDR("CDT") = checkin date/time
+7 ; BSDR("USR") = checkin user
+8 ; BSDR("OPT") = option used to create visit (optional)
+9 ;
+10 ; BSDR("VIEN") = visit IEN (sent if new visit is NOT to be created)
+11 ;
+12 ; variables to create visit under event driver
+13 ; BSDR("CC") = clinic code for creating visit - optional
+14 ; BSDR("PRV") = visit provider - pointer to file 200
+15 ;
+16 ; Output value -
+17 ; = 0 means everything worked
+18 ; = 1^message means error with reason message
+19 ;
+20 IF '$DATA(^DPT(+$GET(BSDR("PAT")),0))
QUIT 1_U_"Patient not on file: "_$GET(BSDR("PAT"))
+21 IF '$DATA(^SC(+$GET(BSDR("CLN")),0))
QUIT 1_U_"Clinic not on file: "_$GET(BSDR("CLN"))
+22 ;PWC allow any time combination of numbers #694
IF $GET(BSDR("ADT"))'?7N1"."1N.N
QUIT 1_U_"Appt Date/Time error: "_$GET(BSDR("ADT"))
+23 ;PWC allow any time combination of numbers #694
IF $GET(BSDR("CDT"))'?7N1"."1N.N
QUIT 1_U_"Checkin Date/Time error: "_$GET(BSDR("CDT"))
+24 IF '$DATA(^VA(200,+$GET(BSDR("USR")),0))
QUIT 1_U_"User Who Made Appt Error: "_$GET(BSDR("USR"))
+25 ;
+26 ; find ien for appt in file 44
+27 NEW IEN,DIE,DA,DR,BSDVSTN
+28 SET IEN=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+29 IF 'IEN
QUIT 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
+30 ;
+31 ; remember before status
+32 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
+33 SET DFN=BSDR("PAT")
SET SDT=BSDR("ADT")
SET SDCL=BSDR("CLN")
SET SDMODE=2
SET SDDA=IEN
+34 SET SDCIHDL=$$HANDLE^SDAMEVT(1)
SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+35 DO BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+36 ;
+37 ; set checkin
+38 NEW SDFDA
+39 ; S SDFDA(44.003,IEN_","_BSDR("ADT")_","_BSDR("CLN")_",",302)=BSDR("USR")
+40 SET SDFDA(44.003,IEN_","_BSDR("ADT")_","_BSDR("CLN")_",",305)=$$NOW^XLFDT()
+41 SET SDFDA(44.003,IEN_","_BSDR("ADT")_","_BSDR("CLN")_",",309)=BSDR("CDT")
+42 DO FILE^DIE("","SDFDA")
+43 KILL SDFDA
+44 ; Updating 302 separately because of trigger on field 309 uses logged-in DUZ
+45 SET SDFDA(44.003,IEN_","_BSDR("ADT")_","_BSDR("CLN")_",",302)=BSDR("USR")
+46 DO FILE^DIE("","SDFDA")
+47 ;
+48 ;S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
+49 ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
+50 ;S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
+51 ;D ^DIE
+52 ;
+53 ; set after status
+54 SET SDDA=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+55 SET SDCIHDL=$$HANDLE^SDAMEVT(1)
SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+56 DO AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
+57 ;
+58 ; set visit variable if not creating new visit
+59 ; event driver kills variable after all protocols run
+60 IF $GET(BSDR("VIEN"))
SET BSDVSTN=BSDR("VIEN")
+61 ;
+62 ; call event driver
+63 ;D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
+64 QUIT 0
+65 ;
CANCEL(BSDR) ;PEP; called to cancel appt
+1 ;
+2 ; Make call using: S ERR=$$CANCEL^SDECAPI(.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 ;PWC allow any time combination of numbers #694
IF $GET(BSDR("ADT"))'?7N1"."1N.N
QUIT 1_U_"Appt Date/Time error: "_$GET(BSDR("ADT"))
+22 ;PWC allow any time combination of numbers #694
IF $GET(BSDR("CDT"))'?7N1"."1N.N
QUIT 1_U_"Cancel Date/Time error: "_$GET(BSDR("CDT"))
+23 IF '$DATA(^VA(200,+$GET(BSDR("USR")),0))
QUIT 1_U_"User Who Canceled Appt Error: "_$GET(BSDR("USR"))
+24 IF '$DATA(^SD(409.2,+$GET(BSDR("CR"))))
QUIT 1_U_"Cancel Reason error: "_$GET(BSDR("CR"))
+25 ;
+26 NEW IEN,DIE,DA,DR
+27 SET IEN=$$SCIEN^SDECU2(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
+28 IF 'IEN
QUIT 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
+29 ;
+30 IF $$CI^SDECU2(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")
+31 ;
+32 ; remember before status
+33 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
+34 SET DFN=BSDR("PAT")
SET SDT=BSDR("ADT")
SET SDCL=BSDR("CLN")
SET SDMODE=2
SET SDDA=IEN
+35 SET SDCPHDL=$$HANDLE^SDAMEVT(1)
SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
+36 DO BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
+37 ;
+38 ; get user who made appt and date appt made from ^SC
+39 ; because data in ^SC will be deleted
+40 NEW USER,DATE
+41 SET USER=$PIECE($GET(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
+42 SET DATE=$PIECE($GET(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
+43 ;
+44 ; update file 2 info
+45 ; allows cancellation to continue if DPT node missing
IF $DATA(^DPT(DFN,"S",SDT))
Begin DoDot:1
+46 NEW DIE,DA,DR
+47 SET DIE="^DPT("_DFN_",""S"","
SET DA(1)=DFN
SET DA=SDT
+48 SET DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
+49 if $GET(BSDR("NOT"))]""
SET DR=DR_";17///"_$EXTRACT(BSDR("NOT"),1,160)
+50 DO ^DIE
End DoDot:1
+51 ;
+52 ; delete data in ^SC
+53 NEW DIK,DA
+54 SET DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
+55 SET DA(2)=BSDR("CLN")
SET DA(1)=BSDR("ADT")
SET DA=IEN
+56 DO ^DIK
+57 ;
+58 ; call event driver
+59 DO CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
+60 QUIT 0
+61 ;
FUTURE(BSDPAT) ;PEPAPI 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 ;
