This fixes two bugs:

1. If a patient has a Patient Cancelled appointment, scheduling the patient at the same time doesn't work anymore.
2. MAKE^BSDXAPI occasionally failed. Use of Old Fileman API not successful. New Fileman API seems to work better in 3986MAKE for filing data into patient subfile of appointment subfile of Hosp Location file.
This commit is contained in:
sam 2010-09-28 09:35:32 +00:00
parent 90183aa36c
commit 3e3e33a14b
1 changed files with 275 additions and 260 deletions

View File

@ -1,260 +1,275 @@
BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 4/29/10 9:42pm BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 9/28/10 12:36pm
;;1.4;BSDX;;Sep 07, 2010 ;;1.4;BSDX;;Sep 07, 2010;Build 7
;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
;local mods (many) by WV/SMH ;local mods (many) by WV/SMH
;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
; ; Change History:
MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment.
; Call like this for DFN 23435 having an appointment at Hospital Location 33 ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API.
; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt ;
; for Baby foxes hallucinations. MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes") ; Call like this for DFN 23435 having an appointment at Hospital Location 33
S BSDR("PAT")=DFN ;DFN ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
S BSDR("CLN")=CLIN ;Hosp Loc IEN ; for Baby foxes hallucinations.
S BSDR("TYP")=TYP ;3 sched or 4 walkin ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
S BSDR("ADT")=DATE ;Appointment date in FM format S BSDR("PAT")=DFN ;DFN
S BSDR("LEN")=LEN ;Appt len upto 240 (min) S BSDR("CLN")=CLIN ;Hosp Loc IEN
S BSDR("INFO")=INFO ;Reason for appt - up to 150 char S BSDR("TYP")=TYP ;3 sched or 4 walkin
S BSDR("USR")=DUZ ;Person who made appt - current user S BSDR("ADT")=DATE ;Appointment date in FM format
Q $$MAKE(.BSDR) S BSDR("LEN")=LEN ;Appt len upto 240 (min)
; S BSDR("INFO")=INFO ;Reason for appt - up to 150 char
MAKE(BSDR) ;PEP; call to store appt made S BSDR("USR")=DUZ ;Person who made appt - current user
; Q $$MAKE(.BSDR)
; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY) ;
; MAKE(BSDR) ;PEP; call to store appt made
; Input Array - ;
; BSDR("PAT") = ien of patient in file 2 ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
; BSDR("CLN") = ien of clinic in file 44 ;
; BSDR("TYP") = 3 for scheduled appts, 4 for walkins ; Input Array -
; BSDR("ADT") = appointment date and time ; BSDR("PAT") = ien of patient in file 2
; BSDR("LEN") = appointment length in minutes (5-120) ; BSDR("CLN") = ien of clinic in file 44
; BSDR("OI") = reason for appt - up to 150 characters ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
; BSDR("USR") = user who made appt ; BSDR("ADT") = appointment date and time
; ; BSDR("LEN") = appointment length in minutes (5-120)
;Output: error status and message ; BSDR("OI") = reason for appt - up to 150 characters
; = 0 or null: everything okay ; BSDR("USR") = user who made appt
; = 1^message: error and reason ;
; ;Output: error status and message
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) ; = 0 or null: everything okay
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) ; = 1^message: error and reason
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 '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 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("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
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") ;
; I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
NEW DIC,DA,Y,X,DD,DO,DLAYGO 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")
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)="C" D ;
. ; "un-cancel" existing appt in file 2 NEW DIC,DA,Y,X,DD,DO,DLAYGO
. N BSDXFDA,BSDXIENS,BSDXMSG ;
. S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
. S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN") . ; "un-cancel" existing appt in file 2
. S BSDXFDA(2.98,BSDXIENS,"3")="" . N BSDXFDA,BSDXIENS,BSDXMSG
. S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
. S BSDXFDA(2.98,BSDXIENS,"9.5")=9 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
. S BSDXFDA(2.98,BSDXIENS,"14")="" . S BSDXFDA(2.98,BSDXIENS,"3")=""
. S BSDXFDA(2.98,BSDXIENS,"15")="" . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
. S BSDXFDA(2.98,BSDXIENS,"16")="" . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
. S BSDXFDA(2.98,BSDXIENS,"19")="" . S BSDXFDA(2.98,BSDXIENS,"14")=""
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT . S BSDXFDA(2.98,BSDXIENS,"15")=""
. D FILE^DIE("","BSDXFDA","BSDXMSG") . S BSDXFDA(2.98,BSDXIENS,"16")=""
. N BSDXTEMP S BSDXTEMP=$G(BSDXMSG) . S BSDXFDA(2.98,BSDXIENS,"19")=""
E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
. N BSDXFDA,BSDXIENS,BSDXMSG . D FILE^DIE("","BSDXFDA","BSDXMSG")
. S BSDXIENS="?+2,"_BSDR("PAT")_"," . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
. S BSDXIENS(2)=BSDR("ADT") E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
. S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN") . N BSDXFDA,BSDXIENS,BSDXMSG
. S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") . S BSDXIENS="?+2,"_BSDR("PAT")_","
. S BSDXFDA(2.98,BSDXIENS,"9.5")=9 . S BSDXIENS(2)=BSDR("ADT")
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
. D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)") . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
; add appt to file 44 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
K DIC,DA,X,Y,DLAYGO,DD,DO . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^" . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
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") ; add appt to file 44
. S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT") K DIC,DA,X,Y,DLAYGO,DD,DO
. S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
. S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN 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")
K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
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///"_$P($$NOW^XLFDT,".") ; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003 ;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
D FILE^DICN ;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
; ;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
; call event driver ;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
NEW DFN,SDT,SDCL,SDDA,SDMODE ;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2 ;D FILE^DICN
S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) ;
D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE) N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_","
Q 0 N BSDXFDA
; S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT")
CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN")
; Call like this for DFN 23435 checking in now at Hospital Location 33 S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150)
; for appt at Dec 20, 2009 @ 10:11:59 S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR")
; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159) S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".")
S BSDR("PAT")=DFN ;DFN N BSDXERR
S BSDR("CLN")=CLIN ;Hosp Loc IEN D UPDATE^DIE("","BSDXFDA","","BSDXERR")
S BSDR("ADT")=APDATE ;Appt Date ;
S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now I $D(BSDXERR) Q 1_U_"Error adding appt to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")_" Patient="_BSDR("PAT")_" Error: "_BSDXERR("DIERR",1,"TEXT",1)
S BSDR("USR")=DUZ ;Check-in user defaults to current ;
Q $$CHECKIN(.BSDR) ; call event driver
; NEW DFN,SDT,SDCL,SDDA,SDMODE
CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
; S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY) D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
; Q 0
; Input array - ;
; BSDR("PAT") = ien of patient in file 2 CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
; BSDR("CLN") = ien of clinic in file 44 ; Call like this for DFN 23435 checking in now at Hospital Location 33
; BSDR("ADT") = appt date/time ; for appt at Dec 20, 2009 @ 10:11:59
; BSDR("CDT") = checkin date/time ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
; BSDR("USR") = checkin user S BSDR("PAT")=DFN ;DFN
; S BSDR("CLN")=CLIN ;Hosp Loc IEN
; Output value - S BSDR("ADT")=APDATE ;Appt Date
; = 0 means everything worked S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now
; = 1^message means error with reason message S BSDR("USR")=DUZ ;Check-in user defaults to current
; Q $$CHECKIN(.BSDR)
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")) CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
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")) ; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
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")) ; Input array -
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) ; BSDR("PAT") = ien of patient in file 2
; ; BSDR("CLN") = ien of clinic in file 44
; find ien for appt in file 44 ; BSDR("ADT") = appt date/time
NEW IEN,DIE,DA,DR ; BSDR("CDT") = checkin date/time
S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) ; BSDR("USR") = checkin user
I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") ;
; ; Output value -
; remember before status ; = 0 means everything worked
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL ; = 1^message means error with reason message
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 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 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
; set checkin I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
D ^DIE ;
; ; find ien for appt in file 44
; set after status NEW IEN,DIE,DA,DR
S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) ;
; ; remember before status
; call event driver NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
Q 0 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
; D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment ;
; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33, ; set checkin
; cancellation initiated by patient ("PC" rather than clinic "C"), S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather) S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
; because foxes come out during bad weather. S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes") D ^DIE
S BSDR("PAT")=DFN ;
S BSDR("CLN")=CLIN ; set after status
S BSDR("TYP")=TYP S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
S BSDR("ADT")=APDATE S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
S BSDR("CDT")=$$NOW^XLFDT D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
S BSDR("USR")=DUZ ;
S BSDR("CR")=REASON ; call event driver
S BSDR("NOT")=INFO D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
Q $$CANCEL(.BSDR) Q 0
; ;
CANCEL(BSDR) ;PEP; called to cancel appt CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
; ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY) ; cancellation initiated by patient ("PC" rather than clinic "C"),
; ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
; Input Array - ; because foxes come out during bad weather.
; BSDR("PAT") = ien of patient in file 2 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
; BSDR("CLN") = ien of clinic in file 44 S BSDR("PAT")=DFN
; BSDR("TYP") = C for canceled by clinic; PC for patient canceled S BSDR("CLN")=CLIN
; BSDR("ADT") = appointment date and time S BSDR("TYP")=TYP
; BSDR("CDT") = cancel date and time S BSDR("ADT")=APDATE
; BSDR("USR") = user who canceled appt S BSDR("CDT")=$$NOW^XLFDT
; BSDR("CR") = cancel reason - pointer to file 409.2 S BSDR("USR")=DUZ
; BSDR("NOT") = cancel remarks - optional notes to 160 characters S BSDR("CR")=REASON
; S BSDR("NOT")=INFO
;Output: error status and message Q $$CANCEL(.BSDR)
; = 0 or null: everything okay ;
; = 1^message: error and reason CANCEL(BSDR) ;PEP; called to cancel appt
; ;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
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")) ; Input Array -
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds ; BSDR("PAT") = ien of patient in file 2
I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) ; BSDR("CLN") = ien of clinic in file 44
I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT")) ; BSDR("ADT") = appointment date and time
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) ; BSDR("CDT") = cancel date and time
I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) ; BSDR("USR") = user who canceled appt
; ; BSDR("CR") = cancel reason - pointer to file 409.2
NEW IEN,DIE,DA,DR ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
S IEN=$$SCIEN(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") ;Output: error status and message
; ; = 0 or null: everything okay
I $$CI(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") ; = 1^message: error and reason
; ;
; remember before status I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) 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
; get user who made appt and date appt made from ^SC I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
; because data in ^SC will be deleted I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
NEW USER,DATE I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
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) NEW IEN,DIE,DA,DR
; S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
; update file 2 info I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
NEW DIE,DA,DR ;
S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT I $$CI(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")
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) ; remember before status
D ^DIE NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
; S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
; delete data in ^SC S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
NEW DIK,DA D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," ;
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN ; get user who made appt and date appt made from ^SC
D ^DIK ; because data in ^SC will be deleted
; NEW USER,DATE
; call event driver S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
Q 0 ;
; ; update file 2 info
CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in NEW DIE,DA,DR
NEW X S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
S X=$G(SDIEN) ;ien sent in call S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U) D ^DIE
Q $S(X:1,1:0) ;
; ; delete data in ^SC
SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC NEW DIK,DA
NEW X,IEN S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
. Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C" ;cancelled D ^DIK
. I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X ;
Q $G(IEN) ; call event driver
; D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in) Q 0
NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7) ;
Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??") CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
; NEW X
CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out S X=$G(SDIEN) ;ien sent in call
NEW X I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
S X=$G(SDIEN) ;ien sent in call S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 Q $S(X:1,1:0)
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3) ;
Q $S(X:1,1:0) SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
; NEW X,IEN
S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
. Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C" ;cancelled
. I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
Q $G(IEN)
;
APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
;
CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
NEW X
S X=$G(SDIEN) ;ien sent in call
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
Q $S(X:1,1:0)
;