Context Navigation

source: Scheduling/trunk/m/BSDXAPI.m@ 1059

Last change on this file since 1059 was 1041, checked in by Sam Habiel, 14 years ago
Updated routines version to 1.42
File size: 12.7 KB

Rev	Line
[1041]	1	BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 12/6/10 5:50pm
	2	;;1.42;BSDX;;Dec 07, 2010;Build 7
[968]	3	;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
	4	;local mods (many) by WV/SMH
	5	;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
	6	; Change History:
[1041]	7	; 2010-11-5:
[968]	8	; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment.
	9	; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API.
[1041]	10	; 2010-11-12:
	11	; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well.
	12	; 2010-12-5
	13	; Added an entry point to update the patient note in file 44.
	14	; 2010-12-6
	15	; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI")
	16	; 2010-12-8
	17	; Removed restriction on max appt length. Even though this restriction
	18	; exists in fileman (120 minutes), PIMS ignores it. Therefore, I
	19	; will ignore it here too.
[968]	20	;
	21	MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
	22	; Call like this for DFN 23435 having an appointment at Hospital Location 33
	23	; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
	24	; for Baby foxes hallucinations.
	25	; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
	26	S BSDR("PAT")=DFN ;DFN
	27	S BSDR("CLN")=CLIN ;Hosp Loc IEN
	28	S BSDR("TYP")=TYP ;3 sched or 4 walkin
	29	S BSDR("ADT")=DATE ;Appointment date in FM format
	30	S BSDR("LEN")=LEN ;Appt len upto 240 (min)
[1035]	31	S BSDR("OI")=INFO ;Reason for appt - up to 150 char
[968]	32	S BSDR("USR")=DUZ ;Person who made appt - current user
	33	Q $$MAKE(.BSDR)
	34	;
	35	MAKE(BSDR) ;PEP; call to store appt made
	36	;
	37	; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
	38	;
	39	; Input Array -
	40	; BSDR("PAT") = ien of patient in file 2
	41	; BSDR("CLN") = ien of clinic in file 44
	42	; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
	43	; BSDR("ADT") = appointment date and time
	44	; BSDR("LEN") = appointment length in minutes (5-120)
	45	; BSDR("OI") = reason for appt - up to 150 characters
	46	; BSDR("USR") = user who made appt
	47	;
	48	;Output: error status and message
	49	; = 0 or null: everything okay
	50	; = 1^message: error and reason
	51	;
	52	I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
	53	I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
	54	I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
	55	I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
	56	I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
	57	;
[1041]	58	;I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) ; v 1.42 - no check on length is done anymore. see top comments for details.
[968]	59	I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
	60	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")
	61	;
	62	NEW DIC,DA,Y,X,DD,DO,DLAYGO
	63	;
	64	I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)["C" D
	65	. ; "un-cancel" existing appt in file 2
	66	. N BSDXFDA,BSDXIENS,BSDXMSG
	67	. S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
	68	. S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
	69	. S BSDXFDA(2.98,BSDXIENS,"3")=""
	70	. S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
	71	. S BSDXFDA(2.98,BSDXIENS,"9.5")=9
	72	. S BSDXFDA(2.98,BSDXIENS,"14")=""
	73	. S BSDXFDA(2.98,BSDXIENS,"15")=""
	74	. S BSDXFDA(2.98,BSDXIENS,"16")=""
	75	. S BSDXFDA(2.98,BSDXIENS,"19")=""
	76	. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
	77	. D FILE^DIE("","BSDXFDA","BSDXMSG")
	78	. N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
	79	E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
	80	. N BSDXFDA,BSDXIENS,BSDXMSG
	81	. S BSDXIENS="?+2,"_BSDR("PAT")_","
	82	. S BSDXIENS(2)=BSDR("ADT")
	83	. S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
	84	. S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
	85	. S BSDXFDA(2.98,BSDXIENS,"9.5")=9
	86	. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
	87	. D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
	88	; add appt to file 44
	89	K DIC,DA,X,Y,DLAYGO,DD,DO
	90	I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
	91	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")
	92	. S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
	93	. S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
	94	. S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
	95	;
	96	; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
	97	;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
	98	;S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
	99	;S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
	100	;S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
	101	;S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
	102	;D FILE^DICN
	103	;
	104	N BSDXIENS S BSDXIENS="?+1,"_BSDR("ADT")_","_BSDR("CLN")_","
	105	N BSDXFDA
	106	S BSDXFDA(44.003,BSDXIENS,.01)=BSDR("PAT")
	107	S BSDXFDA(44.003,BSDXIENS,1)=BSDR("LEN")
	108	S BSDXFDA(44.003,BSDXIENS,3)=$E($G(BSDR("OI")),1,150)
	109	S BSDXFDA(44.003,BSDXIENS,7)=BSDR("USR")
	110	S BSDXFDA(44.003,BSDXIENS,8)=$P($$NOW^XLFDT,".")
	111	N BSDXERR
	112	D UPDATE^DIE("","BSDXFDA","","BSDXERR")
	113	;
	114	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)
	115	;
	116	; call event driver
	117	NEW DFN,SDT,SDCL,SDDA,SDMODE
	118	S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
	119	S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
	120	D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
	121	Q 0
	122	;
	123	CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
	124	; Call like this for DFN 23435 checking in now at Hospital Location 33
	125	; for appt at Dec 20, 2009 @ 10:11:59
	126	; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
	127	S BSDR("PAT")=DFN ;DFN
	128	S BSDR("CLN")=CLIN ;Hosp Loc IEN
	129	S BSDR("ADT")=APDATE ;Appt Date
	130	S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now
	131	S BSDR("USR")=DUZ ;Check-in user defaults to current
	132	Q $$CHECKIN(.BSDR)
	133	;
	134	CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
	135	;
	136	; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
	137	;
	138	; Input array -
	139	; BSDR("PAT") = ien of patient in file 2
	140	; BSDR("CLN") = ien of clinic in file 44
	141	; BSDR("ADT") = appt date/time
	142	; BSDR("CDT") = checkin date/time
	143	; BSDR("USR") = checkin user
	144	;
	145	; Output value -
	146	; = 0 means everything worked
	147	; = 1^message means error with reason message
	148	;
	149	I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
	150	I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
	151	I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
	152	I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
	153	I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
	154	I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
	155	I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
	156	;
	157	; find ien for appt in file 44
	158	NEW IEN,DIE,DA,DR
	159	S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
	160	I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
	161	;
	162	; remember before status
	163	NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
	164	S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
	165	S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
	166	D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
	167	;
	168	; set checkin
	169	S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
	170	S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
	171	S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
	172	D ^DIE
	173	;
	174	; set after status
	175	S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
	176	S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
	177	D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
	178	;
	179	; call event driver
	180	D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
	181	Q 0
	182	;
	183	CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
	184	; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
	185	; cancellation initiated by patient ("PC" rather than clinic "C"),
	186	; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
	187	; because foxes come out during bad weather.
	188	; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
	189	S BSDR("PAT")=DFN
	190	S BSDR("CLN")=CLIN
	191	S BSDR("TYP")=TYP
	192	S BSDR("ADT")=APDATE
	193	S BSDR("CDT")=$$NOW^XLFDT
	194	S BSDR("USR")=DUZ
	195	S BSDR("CR")=REASON
	196	S BSDR("NOT")=INFO
	197	Q $$CANCEL(.BSDR)
	198	;
	199	CANCEL(BSDR) ;PEP; called to cancel appt
	200	;
	201	; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
	202	;
	203	; Input Array -
	204	; BSDR("PAT") = ien of patient in file 2
	205	; BSDR("CLN") = ien of clinic in file 44
	206	; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
	207	; BSDR("ADT") = appointment date and time
	208	; BSDR("CDT") = cancel date and time
	209	; BSDR("USR") = user who canceled appt
	210	; BSDR("CR") = cancel reason - pointer to file 409.2
	211	; BSDR("NOT") = cancel remarks - optional notes to 160 characters
	212	;
	213	;Output: error status and message
	214	; = 0 or null: everything okay
	215	; = 1^message: error and reason
	216	;
	217	I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
	218	I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
	219	I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
	220	I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
	221	I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
	222	I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds
	223	I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
	224	I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
	225	I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
	226	;
	227	NEW IEN,DIE,DA,DR
	228	S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
	229	I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
	230	;
	231	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")
	232	;
	233	; remember before status
	234	NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
	235	S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
	236	S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
	237	D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
	238	;
	239	; get user who made appt and date appt made from ^SC
	240	; because data in ^SC will be deleted
	241	NEW USER,DATE
	242	S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
	243	S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
	244	;
	245	; update file 2 info
	246	NEW DIE,DA,DR
	247	S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
	248	S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
	249	S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
	250	D ^DIE
	251	;
	252	; delete data in ^SC
	253	NEW DIK,DA
	254	S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
	255	S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
	256	D ^DIK
	257	;
	258	; call event driver
	259	D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
	260	Q 0
	261	;
	262	CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
	263	NEW X
	264	S X=$G(SDIEN) ;ien sent in call
	265	I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
	266	S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
	267	Q $S(X:1,1:0)
	268	;
	269	SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
	270	NEW X,IEN
	271	S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
[1006]	272	. Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)["C" ;cancelled
[968]	273	. I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
	274	Q $G(IEN)
	275	;
	276	APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
	277	NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
	278	Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
	279	;
	280	CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
	281	NEW X
	282	S X=$G(SDIEN) ;ien sent in call
	283	I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
	284	S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
	285	Q $S(X:1,1:0)
	286	;
[1041]	287	UPDATENOTE(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
	288	; PAT = DFN
	289	; CLINIC = SC IEN
	290	; DATE = FM Date/Time of Appointment
	291	;
	292	; Returns:
	293	; 0 if okay
	294	; -1 if failure
	295	N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
	296	I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
	297	N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
	298	S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
	299	N BSDXERR
	300	D FILE^DIE("","BSDXFDA","BSDXERR")
	301	I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1)
	302	QUIT 0

Note: See TracBrowser for help on using the repository browser.

Download in other formats: