Changeset 888 for Scheduling/trunk/m/BSDXAPI.m
- Timestamp:
- Jul 18, 2010, 9:58:35 AM (16 years ago)
- File:
-
- 1 edited
-
Scheduling/trunk/m/BSDXAPI.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDXAPI.m
r742 r888 1 BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 4/29/10 9:42pm2 ;;2.1;BSDX;;24JUL2009 3 ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW4 ;local mods (many) by WV/SMH5 ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH6 ;7 MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment8 ; Call like this for DFN 23435 having an appointment at Hospital Location 339 ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt10 ; for Baby foxes hallucinations.11 ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")12 S BSDR("PAT")=DFN ;DFN13 S BSDR("CLN")=CLIN ;Hosp Loc IEN14 S BSDR("TYP")=TYP ;3 sched or 4 walkin15 S BSDR("ADT")=DATE ;Appointment date in FM format16 S BSDR("LEN")=LEN ;Appt len upto 240 (min)17 S BSDR("INFO")=INFO ;Reason for appt - up to 150 char18 S BSDR("USR")=DUZ ;Person who made appt - current user19 Q $$MAKE(.BSDR)20 ;21 MAKE(BSDR) ;PEP; call to store appt made22 ;23 ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)24 ;25 ; Input Array -26 ; BSDR("PAT") = ien of patient in file 227 ; BSDR("CLN") = ien of clinic in file 4428 ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins29 ; BSDR("ADT") = appointment date and time30 ; BSDR("LEN") = appointment length in minutes (5-120)31 ; BSDR("OI") = reason for appt - up to 150 characters32 ; BSDR("USR") = user who made appt33 ;34 ;Output: error status and message35 ; = 0 or null: everything okay36 ; = 1^message: error and reason37 ;38 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))39 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))40 I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))41 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds42 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))43 ;44 I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))45 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))46 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")47 ;48 NEW DIC,DA,Y,X,DD,DO,DLAYGO49 ;50 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)="C" D51 . ; "un-cancel" existing appt in file 252 . N BSDXFDA,BSDXIENS,BSDXMSG53 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","54 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")55 . S BSDXFDA(2.98,BSDXIENS,"3")=""56 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")57 . S BSDXFDA(2.98,BSDXIENS,"9.5")=958 . S BSDXFDA(2.98,BSDXIENS,"14")=""59 . S BSDXFDA(2.98,BSDXIENS,"15")=""60 . S BSDXFDA(2.98,BSDXIENS,"16")=""61 . S BSDXFDA(2.98,BSDXIENS,"19")=""62 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT63 . D FILE^DIE("","BSDXFDA","BSDXMSG")64 . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)65 E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")66 . N BSDXFDA,BSDXIENS,BSDXMSG67 . S BSDXIENS="?+2,"_BSDR("PAT")_","68 . S BSDXIENS(2)=BSDR("ADT")69 . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")70 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")71 . S BSDXFDA(2.98,BSDXIENS,"9.5")=972 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT73 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")74 ; add appt to file 4475 K DIC,DA,X,Y,DLAYGO,DD,DO76 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"77 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")78 . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")79 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.00180 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN81 ;82 K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM83 S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"84 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")85 S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")86 S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.00387 D FILE^DICN88 ;89 ; call event driver90 NEW DFN,SDT,SDCL,SDDA,SDMODE91 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=292 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))93 D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)94 Q 095 ;96 CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in97 ; Call like this for DFN 23435 checking in now at Hospital Location 3398 ; for appt at Dec 20, 2009 @ 10:11:5999 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)100 S BSDR("PAT")=DFN ;DFN101 S BSDR("CLN")=CLIN ;Hosp Loc IEN102 S BSDR("ADT")=APDATE ;Appt Date103 S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now104 S BSDR("USR")=DUZ ;Check-in user defaults to current105 Q $$CHECKIN(.BSDR)106 ;107 CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002108 ;109 ; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY)110 ;111 ; Input array -112 ; BSDR("PAT") = ien of patient in file 2113 ; BSDR("CLN") = ien of clinic in file 44114 ; BSDR("ADT") = appt date/time115 ; BSDR("CDT") = checkin date/time116 ; BSDR("USR") = checkin user117 ;118 ; Output value -119 ; = 0 means everything worked120 ; = 1^message means error with reason message121 ;122 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))123 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))124 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds125 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))126 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds127 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))128 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))129 ;130 ; find ien for appt in file 44131 NEW IEN,DIE,DA,DR132 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))133 I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")134 ;135 ; remember before status136 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL137 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN138 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL139 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)140 ;141 ; set checkin142 S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"143 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN144 S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT145 D ^DIE146 ;147 ; set after status148 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))149 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL150 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)151 ;152 ; call event driver153 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)154 Q 0155 ;156 CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment157 ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,158 ; cancellation initiated by patient ("PC" rather than clinic "C"),159 ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)160 ; because foxes come out during bad weather.161 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")162 S BSDR("PAT")=DFN163 S BSDR("CLN")=CLIN164 S BSDR("TYP")=TYP165 S BSDR("ADT")=APDATE166 S BSDR("CDT")=$$NOW^XLFDT167 S BSDR("USR")=DUZ168 S BSDR("CR")=REASON169 S BSDR("NOT")=INFO170 Q $$CANCEL(.BSDR)171 ;172 CANCEL(BSDR) ;PEP; called to cancel appt173 ;174 ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)175 ;176 ; Input Array -177 ; BSDR("PAT") = ien of patient in file 2178 ; BSDR("CLN") = ien of clinic in file 44179 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled180 ; BSDR("ADT") = appointment date and time181 ; BSDR("CDT") = cancel date and time182 ; BSDR("USR") = user who canceled appt183 ; BSDR("CR") = cancel reason - pointer to file 409.2184 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters185 ;186 ;Output: error status and message187 ; = 0 or null: everything okay188 ; = 1^message: error and reason189 ;190 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))191 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))192 I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))193 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds194 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))195 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds196 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))197 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))198 I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))199 ;200 NEW IEN,DIE,DA,DR201 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))202 I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")203 ;204 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")205 ;206 ; remember before status207 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL208 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN209 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL210 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)211 ;212 ; get user who made appt and date appt made from ^SC213 ; because data in ^SC will be deleted214 NEW USER,DATE215 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)216 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)217 ;218 ; update file 2 info219 NEW DIE,DA,DR220 S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT221 S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE222 S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)223 D ^DIE224 ;225 ; delete data in ^SC226 NEW DIK,DA227 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"228 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN229 D ^DIK230 ;231 ; call event driver232 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)233 Q 0234 ;235 CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in236 NEW X237 S X=$G(SDIEN) ;ien sent in call238 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0239 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)240 Q $S(X:1,1:0)241 ;242 SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC243 NEW X,IEN244 S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D245 . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C" ;cancelled246 . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X247 Q $G(IEN)248 ;249 APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)250 NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)251 Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")252 ;253 CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out254 NEW X255 S X=$G(SDIEN) ;ien sent in call256 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0257 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)258 Q $S(X:1,1:0)259 ;260 1 BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 4/29/10 9:42pm 2 ;;1.3T1;BSDX;;Jul 18, 2010 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 ; 7 MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment 8 ; Call like this for DFN 23435 having an appointment at Hospital Location 33 9 ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt 10 ; for Baby foxes hallucinations. 11 ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes") 12 S BSDR("PAT")=DFN ;DFN 13 S BSDR("CLN")=CLIN ;Hosp Loc IEN 14 S BSDR("TYP")=TYP ;3 sched or 4 walkin 15 S BSDR("ADT")=DATE ;Appointment date in FM format 16 S BSDR("LEN")=LEN ;Appt len upto 240 (min) 17 S BSDR("INFO")=INFO ;Reason for appt - up to 150 char 18 S BSDR("USR")=DUZ ;Person who made appt - current user 19 Q $$MAKE(.BSDR) 20 ; 21 MAKE(BSDR) ;PEP; call to store appt made 22 ; 23 ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY) 24 ; 25 ; Input Array - 26 ; BSDR("PAT") = ien of patient in file 2 27 ; BSDR("CLN") = ien of clinic in file 44 28 ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins 29 ; BSDR("ADT") = appointment date and time 30 ; BSDR("LEN") = appointment length in minutes (5-120) 31 ; BSDR("OI") = reason for appt - up to 150 characters 32 ; BSDR("USR") = user who made appt 33 ; 34 ;Output: error status and message 35 ; = 0 or null: everything okay 36 ; = 1^message: error and reason 37 ; 38 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) 39 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) 40 I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP")) 41 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds 42 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 43 ; 44 I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) 45 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) 46 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") 47 ; 48 NEW DIC,DA,Y,X,DD,DO,DLAYGO 49 ; 50 I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)="C" D 51 . ; "un-cancel" existing appt in file 2 52 . N BSDXFDA,BSDXIENS,BSDXMSG 53 . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_"," 54 . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN") 55 . S BSDXFDA(2.98,BSDXIENS,"3")="" 56 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") 57 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 58 . S BSDXFDA(2.98,BSDXIENS,"14")="" 59 . S BSDXFDA(2.98,BSDXIENS,"15")="" 60 . S BSDXFDA(2.98,BSDXIENS,"16")="" 61 . S BSDXFDA(2.98,BSDXIENS,"19")="" 62 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT 63 . D FILE^DIE("","BSDXFDA","BSDXMSG") 64 . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG) 65 E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") 66 . N BSDXFDA,BSDXIENS,BSDXMSG 67 . S BSDXIENS="?+2,"_BSDR("PAT")_"," 68 . S BSDXIENS(2)=BSDR("ADT") 69 . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN") 70 . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP") 71 . S BSDXFDA(2.98,BSDXIENS,"9.5")=9 72 . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT 73 . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)") 74 ; add appt to file 44 75 K DIC,DA,X,Y,DLAYGO,DD,DO 76 I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^" 77 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") 78 . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT") 79 . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001 80 . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN 81 ; 82 K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM 83 S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 84 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT") 85 S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".") 86 S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003 87 D FILE^DICN 88 ; 89 ; call event driver 90 NEW DFN,SDT,SDCL,SDDA,SDMODE 91 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2 92 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 93 D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE) 94 Q 0 95 ; 96 CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in 97 ; Call like this for DFN 23435 checking in now at Hospital Location 33 98 ; for appt at Dec 20, 2009 @ 10:11:59 99 ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159) 100 S BSDR("PAT")=DFN ;DFN 101 S BSDR("CLN")=CLIN ;Hosp Loc IEN 102 S BSDR("ADT")=APDATE ;Appt Date 103 S BSDR("CDT")=$$NOW^XLFDT ;Check-in date defaults to now 104 S BSDR("USR")=DUZ ;Check-in user defaults to current 105 Q $$CHECKIN(.BSDR) 106 ; 107 CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002 108 ; 109 ; Make call by using: S ERR=$$CHECKIN^BSDXAPI(.ARRAY) 110 ; 111 ; Input array - 112 ; BSDR("PAT") = ien of patient in file 2 113 ; BSDR("CLN") = ien of clinic in file 44 114 ; BSDR("ADT") = appt date/time 115 ; BSDR("CDT") = checkin date/time 116 ; BSDR("USR") = checkin user 117 ; 118 ; Output value - 119 ; = 0 means everything worked 120 ; = 1^message means error with reason message 121 ; 122 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) 123 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) 124 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds 125 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 126 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds 127 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT")) 128 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR")) 129 ; 130 ; find ien for appt in file 44 131 NEW IEN,DIE,DA,DR 132 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 133 I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") 134 ; 135 ; remember before status 136 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL 137 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN 138 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 139 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 140 ; 141 ; set checkin 142 S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 143 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN 144 S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT 145 D ^DIE 146 ; 147 ; set after status 148 S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 149 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 150 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 151 ; 152 ; call event driver 153 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) 154 Q 0 155 ; 156 CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment 157 ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33, 158 ; cancellation initiated by patient ("PC" rather than clinic "C"), 159 ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather) 160 ; because foxes come out during bad weather. 161 ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes") 162 S BSDR("PAT")=DFN 163 S BSDR("CLN")=CLIN 164 S BSDR("TYP")=TYP 165 S BSDR("ADT")=APDATE 166 S BSDR("CDT")=$$NOW^XLFDT 167 S BSDR("USR")=DUZ 168 S BSDR("CR")=REASON 169 S BSDR("NOT")=INFO 170 Q $$CANCEL(.BSDR) 171 ; 172 CANCEL(BSDR) ;PEP; called to cancel appt 173 ; 174 ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY) 175 ; 176 ; Input Array - 177 ; BSDR("PAT") = ien of patient in file 2 178 ; BSDR("CLN") = ien of clinic in file 44 179 ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled 180 ; BSDR("ADT") = appointment date and time 181 ; BSDR("CDT") = cancel date and time 182 ; BSDR("USR") = user who canceled appt 183 ; BSDR("CR") = cancel reason - pointer to file 409.2 184 ; BSDR("NOT") = cancel remarks - optional notes to 160 characters 185 ; 186 ;Output: error status and message 187 ; = 0 or null: everything okay 188 ; = 1^message: error and reason 189 ; 190 I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT")) 191 I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN")) 192 I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP")) 193 I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds 194 I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT")) 195 I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12) ;remove seconds 196 I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT")) 197 I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR")) 198 I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR")) 199 ; 200 NEW IEN,DIE,DA,DR 201 S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT")) 202 I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT") 203 ; 204 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") 205 ; 206 ; remember before status 207 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL 208 S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN 209 S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 210 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) 211 ; 212 ; get user who made appt and date appt made from ^SC 213 ; because data in ^SC will be deleted 214 NEW USER,DATE 215 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) 216 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) 217 ; 218 ; update file 2 info 219 NEW DIE,DA,DR 220 S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT 221 S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE 222 S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160) 223 D ^DIE 224 ; 225 ; delete data in ^SC 226 NEW DIK,DA 227 S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1," 228 S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN 229 D ^DIK 230 ; 231 ; call event driver 232 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) 233 Q 0 234 ; 235 CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in 236 NEW X 237 S X=$G(SDIEN) ;ien sent in call 238 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 239 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U) 240 Q $S(X:1,1:0) 241 ; 242 SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC 243 NEW X,IEN 244 S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D 245 . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C" ;cancelled 246 . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X 247 Q $G(IEN) 248 ; 249 APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in) 250 NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7) 251 Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??") 252 ; 253 CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out 254 NEW X 255 S X=$G(SDIEN) ;ien sent in call 256 I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0 257 S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3) 258 Q $S(X:1,1:0) 259 ; 260
Note:
See TracChangeset
for help on using the changeset viewer.
