- BSDX25 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
- ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
- ;
- ;
- CHECKIND(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG,BSDXCR) ;EP
- ;Entry point for debugging
- ;
- ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))
- ;E G ENDBG
- Q
- ;
- CHECKIN(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG,BSDXCR,BSDXPCC,BSDXWHF) ;EP Check in appointment
- ;
- ; INPUT: BSDXAPTID - Appointment ID
- ; BSDXCDT - Check-in date/time. ("@" - indicates delete check-in)
- ; BSDXCC -
- ; BSDXPRV -
- ; BSDXROU - Print Routing Slip flag
- ; BSDXVCL -
- ; BSDXVFM -
- ; BSDXOG -
- ; BSDXCR - Generate Chart request upon check-in? (1-Yes, otherwise no)
- ; BSDXPCC - ien of PWH Type in HEALTH SUMMARY PWH TYPE file ^APCHPWHT
- ; BSDXWHF - Print Patient Wellness Handout flag
- ;
- ENDBG ;
- N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXZ,BSDXIENS,BSDXVEN
- N BSDXNOEV,BSDXCAN,EMSG
- S EMSG=""
- S BSDXNOEV=1 ;Don't execute protocol
- S BSDXCAN=0
- ;
- D ^XBKVAR S X="ERROR^BSDX25",@^%ZOSF("TRAP")
- S BSDXI=0
- K ^BSDXTMP($J)
- S BSDXY="^BSDXTMP("_$J_")"
- S ^BSDXTMP($J,0)="T00020ERRORID^T00150MESSAGE"_$C(30)
- I '+BSDXAPTID D ERR("Invalid Appointment ID") Q
- I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR("Invalid Appointment ID") Q
- ;
- S:BSDXCDT="@" BSDXCAN=1
- S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@")
- S %DT="T",X=BSDXCDT D ^%DT S BSDXCDT=Y
- I '$G(BSDXCAN),BSDXCDT=-1 D ERR(70) Q
- I BSDXCDT>$$NOW^XLFDT S BSDXCDT=$$NOW^XLFDT
- S BSDXCDT=$P(BSDXCDT,".",1)_"."_$E($P(BSDXCDT,".",2),1,4)
- S BSDXNOD=^BSDXAPPT(BSDXAPTID,0)
- S DFN=$P(BSDXNOD,U,5)
- S BSDXPATID=$P(BSDXNOD,U,5)
- S BSDXSTART=$P(BSDXNOD,U)
- ;
- S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
- ;if resourceId is not null AND there is a valid resource record
- I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I +$G(BSDXZ) D ERR($P(BSDXZ,U,2)) Q
- . S BSDXNOD=^BSDXRES(BSDXSC1,0)
- . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
- . ;Hospital Location is required for CHECKIN
- . I 'BSDXSC1]"",'$D(^SC(+BSDXSC1,0)) D ERR("RPMS Clinic not defined for this Resource: "_$P(BSDXNOD,U,1)_" ("_BSDXSC1_")") Q
- . ;Checkin BSDX APPOINTMENT entry
- . D BSDXCHK(BSDXAPTID,$S(BSDXCAN:"",1:BSDXCDT)) ; sets field .03 (Checkin), in file 9002018.4
- . ;Process cancel checkin
- . I $G(BSDXCAN) D CANCHKIN(BSDXPATID,BSDXSC1,BSDXSTART) Q
- . D APCHK(.BSDXZ,BSDXSC1,BSDXPATID,BSDXCDT,BSDXSTART,BSDXCC,BSDXPRV,BSDXVCL,BSDXVFM,BSDXOG)
- . I $G(BSDXPRV) S DIE="^BSDXAPPT(",DA=BSDXAPTID,DR=".16///"_BSDXPRV D ^DIE
- . ;S DGQUIET=1
- . I $G(BSDXROU)="true" D WISD^BSDX42(DFN,$P(BSDXCDT,"."),"SD",,,.EMSG) ;print routing slip
- . I $G(BSDXPCC)'="" D WISD^BSDX43(DFN,$P(BSDXCDT,"."),"SD",BSDXPCC,.EMSG) ;print PCC health summary
- . I $G(BSDXWHF)="true" D WISDW^BSDX42(DFN,$P(BSDXCDT,"."),.EMSG) ;print patient wellness handout
- . I $G(BSDXCR),$$GET1^DIQ(9002018.4,BSDXAPTID,.13)="YES" D
- . . S BSDXDEV=$$GET1^DIQ(9009020.2,$$DIV^BSDU,.05) I BSDXDEV="" D ERR("Chart request failed - No default file room printer found.") Q
- . . S DGQUIET=1 D WISD^BSDROUT(BSDXPATID,$P(BSDXSTART,"."),"",BSDXDEV)
- ;
- S BSDXI=BSDXI+1
- S ^BSDXTMP($J,BSDXI)="0^"_$S(EMSG'="":EMSG,1:"")_$C(30)
- S BSDXI=BSDXI+1
- S ^BSDXTMP($J,BSDXI)=$C(31)
- Q
- ;
- BSDXCHK(BSDXAPTID,BSDXCDT) ;
- ;
- S BSDXIENS=BSDXAPTID_","
- S BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT
- D FILE^DIE("","BSDXFDA","BSDXMSG")
- Q
- ;
- APCHK(BSDXZ,BSDXSC1,BSDXDFN,BSDXCDT,BSDXSTART,BSDXCC,BSDXPRV,BSDXVCL,BSDXVFM,BSDXOG) ;
- ;Checkin appointment for patient BSDXDFN in clinic BSDXSC1
- ;at time BSDXSD
- N BSDXC,BSDXOUT,IEN
- ; 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
- S BSDXC("PAT")=BSDXDFN
- ;S BSDXC("CLN")=BSDXSC1
- S BSDXC("HOS LOC")=BSDXSC1
- ;S BSDXC("CC")=BSDXCC
- S BSDXC("CLINIC CODE")=$G(BSDXCC)
- ;S BSDXC("PRV")=$G(BSDXPRV)
- S BSDXC("PROVIDER")=$G(BSDXPRV)
- ;S BSDXC("ADT")=BSDXSTART
- S BSDXC("APPT DATE")=BSDXSTART
- S BSDXC("CDT")=BSDXCDT
- S BSDXC("USR")=DUZ
- ;find IEN in ^SC multiple or null
- S APTN=$$FIND^SDAM2(BSDXC("PAT"),BSDXC("APPT DATE"),BSDXC("HOS LOC"))
- ;
- ;Required by NEW API:
- S BSDXC("TIME RANGE")=-1
- S BSDXC("VISIT DATE")=BSDXCDT ;IHS/HMW **1** 20060419
- S BSDXC("SITE")=$G(DUZ(2))
- S BSDXC("VISIT TYPE")=$$GET1^DIQ(9001001.2,BSDXC("SITE"),.11,"I")
- I BSDXC("VISIT TYPE")="" S BSDXC("VISIT TYPE")=$$GET1^DIQ(9001000,BSDXC("SITE"),.04,"I")
- I BSDXC("VISIT TYPE")="" S BSDXC("VISIT TYPE")="I"
- S BSDXC("SRV CAT")=$$GET1^DIQ(9001001.2,BSDXC("SITE"),.12,"I")
- I BSDXC("SRV CAT")="" S BSDXC("SRV CAT")="A"
- ;TELL LINDA ABOUT THESE 2 -- SAME VARIABLES WITH DIFFERENT NAMES
- S BSDXC("CLN")=BSDXC("HOS LOC")
- S BSDXC("ADT")=BSDXC("APPT DATE")
- ;
- ;Set up BSDXVEN array containing VEN EHP CLINIC, VEN EHP FORM, OUTGUIDE FLAG
- ;These values come from input param
- S BSDXVEN("CLINIC")=$G(BSDXVCL)
- S BSDXVEN("FORM")=$G(BSDXVFM)
- S BSDXVEN("OUTGUIDE")=$G(BSDXOG)
- ;
- S BSDXC("APCDAPPT")=$S($P(^DPT(BSDXC("PAT"),"S",BSDXC("APPT DATE"),0),U,7)=3:"A",$P(^DPT(BSDXC("PAT"),"S",BSDXC("APPT DATE"),0),U,7)=4:"W",1:"U") ;walk-in vs appt
- I "CT"[BSDXC("SRV CAT") K BSDXC("APCDAPPT") ;not needed for phone calls & chart reviews
- S BSDXC("APCDOPT")=$O(^DIC(19,"B","SD IHS PCC LINK",0))
- S IEN=$$SCIEN^BSDU2(BSDXC("PAT"),BSDXC("HOS LOC"),BSDXC("APPT DATE")) ;find appt
- ; set checkin
- K DIE,DA,DR
- S DIE="^SC("_BSDXC("HOS LOC")_",""S"","_BSDXC("APPT DATE")_",1,"
- S DA(2)=BSDXC("HOS LOC"),DA(1)=BSDXC("APPT DATE"),DA=IEN
- S DR="309///"_BSDXC("VISIT DATE")_";302///`"_BSDXC("USR")_";305///"_$$NOW^XLFDT
- D ^DIE
- I $$GET1^DIQ(9009017.2,+BSDXC("HOS LOC"),.09)'="YES" Q ;don't create visit
- S BSDXC("CALLER")="BSD CHECKIN"
- D GETVISIT^BSDAPI4(.BSDXC,.BSDXOUT) ;call to check for existing visit and checkin appt; checkin appt should create visit if needed
- ;if we came back with at least 1 existing visit, we are done; otherwise we need to create a visit.
- I 'BSDXOUT(0) D
- . S BSDXC("FORCE ADD")=1
- . D GETVISIT^BSDAPI4(.BSDXC,.BSDXOUT)
- ;
- ; add provider to visit
- I $G(BSDXC("PROVIDER")) D
- . N BSDXVSTR,BSDXIEN
- . S BSDXIEN=$O(BSDXOUT(0))
- . S BSDXVSTR=$$VIS2VSTR^BEHOENCX(BSDXC("PAT"),BSDXIEN)
- . D UPDPRV^BEHOENCX(,BSDXC("PAT"),BSDXVSTR,BSDXC("PROVIDER"))
- Q
- ;
- CANCHKIN(DFN,SDCL,SDT) ; Logic to cancel a checkin if the checkin date/time is passed in as '@'
- ; input: DFN := ifn of patient
- ; SDCL := clinic#
- ; SDT := appt d/t
- ;
- N SDDA
- S SDDA=$$FIND(DFN,SDT,SDCL)
- ;I 'SDDA D ERR("BSDX25: Could not locate appointment in database or appointment is cancelled.") Q
- I 'SDDA D ERR("Could not locate appointment in database or appointment is cancelled.") Q
- N SDATA,SDCIHDL,X S SDATA=SDDA_U_DFN_U_SDT_U_SDCL,SDCIHDL=$$HANDLE^SDAMEVT(1)
- D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
- S FDA(44.003,SDDA_","_SDT_","_SDCL_",",309)="" D FILE^DIE(,"FDA","ERR")
- D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
- D CHKEVTD(DFN,SDT,SDCL)
- K FDA,ERR
- Q
- ;
- FIND(DFN,SDT,SDCL) ; -- return appt ifn for pat
- ; input: DFN := ifn of pat.
- ; SDT := appt d/t
- ; SDCL := ifn of clinic
- ; output: [returned] := ifn if pat has appt on date/time
- ;
- N Y
- S Y=0 F S Y=$O(^SC(SDCL,"S",SDT,1,Y)) Q:'Y I $D(^(Y,0)),DFN=+^(0),$D(^DPT(+DFN,"S",SDT,0)),$$VALID(DFN,SDCL,SDT,Y) Q
- Q Y
- ;
- VALID(DFN,SDCL,SDT,SDDA) ; -- return valid appt.
- ; **NOTE: For speed consideration the ^SC and ^DPT nodes must be
- ; check to see they exist prior to calling this entry point.
- ; input: DFN := ifn of pat.
- ; SDT := appt d/t
- ; SDCL := ifn of clinic
- ; SDDA := ifn of appt
- ; output: [returned] := 1 for valid appt., 0 for not valid
- Q $S($P(^SC(SDCL,"S",SDT,1,SDDA,0),U,9)'="C":1,$P(^DPT(DFN,"S",SDT,0),U,2)["C":1,1:0)
- ;
- CHKEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CHECKIN APPOINTMENT event
- ;when appointments CHECKIN via PIMS interface.
- ;Propagates CHECKIN to BSDXAPPT and raises refresh event to running GUI clients
- ;
- Q:+$G(BSDXNOEV)
- Q:'+$G(BSDXSC)
- N BSDXSTAT,BSDXFOUND,BSDXRES
- S BSDXSTAT=""
- S:$G(SDATA("AFTER","STATUS"))["CHECKED IN" BSDXSTAT=$P(SDATA("AFTER","STATUS"),"^",4)
- S BSDXFOUND=0
- I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
- I BSDXFOUND D CHKEVT3(BSDXRES) Q
- I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
- I BSDXFOUND D CHKEVT3(BSDXRES)
- Q
- ;
- CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
- ;Get appointment id in BSDXAPT
- ;If found, call BSDXNOS(BSDXAPPT) and return 1
- ;else return 0
- N BSDXFOUND,BSDXAPPT
- S BSDXFOUND=0
- Q:'+$G(BSDXRES) BSDXFOUND
- Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
- S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND
- . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
- . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
- I BSDXFOUND,+$G(BSDXAPPT) D BSDXCHK(BSDXAPPT,BSDXSTAT)
- Q BSDXFOUND
- ;
- CHKEVT3(BSDXRES) ;
- ;Call RaiseEvent to notify GUI clients
- ;
- N BSDXRESN
- S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
- Q:BSDXRESN=""
- S BSDXRESN=$P(BSDXRESN,"^")
- ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
- D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
- Q
- ;
- CHKEVTD(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CHECKIN APPOINTMENT event
- ;when an appointment CHECKIN is deleted via.
- ;Deletes CHECKIN to and raises refresh event to running GUI clients
- ;
- ;
- Q:+$G(BSDXNOEV)
- Q:'+$G(BSDXSC)
- N BSDXSTAT,BSDXFOUND,BSDXRES
- S BSDXSTAT=""
- S:$G(SDATA("AFTER","STATUS"))'="CHECKED IN" BSDXSTAT=$P(SDATA("AFTER","STATUS"),"^",4)
- I BSDXSTAT="" S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
- I BSDXRES D CHKEVT3(BSDXRES) Q
- S BSDXFOUND=0
- ;
- ;I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
- ;I BSDXFOUND D CHKEVT3(BSDXRES) Q
- ;I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
- ;I BSDXFOUND D CHKEVT3(BSDXRES)
- Q
- ;
- ;CHECK OUT APPOINTMENT - RPC
- CHECKOUT(BSDXY,DFN,SDT,SDCODT,BSDXAPTID,VPRV) ;EP Check Out appointment
- ; Returns BSDXY
- ; Input -- DFN Patient file IEN
- ; SDT Appointment Date/Time in FM format
- ; SDCODT Date/Time of Check Out FM FORMAT [REQUIRED]
- ; BSDXAPTID - Appointment ID
- ; VPRV - V Provider
- ; called by BSDX CHECKOUT APPOINTMENT remote procedure
- ;SETUP ERROR TRACKING
- D ^XBKVAR S X="ERROR^BSDX25",@^%ZOSF("TRAP")
- S BSDXI=0
- K ^BSDXTMP($J)
- S BSDXY="^BSDXTMP("_$J_")"
- S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
- I '+BSDXAPTID D ERR("Invalid Appointment ID.") Q
- I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR("Invalid Appointment ID.") Q
- ;INITIALIZE VARIABLES
- S %DT="T"
- S X=SDT
- D ^%DT ; GET FM FORMAT FOR APPOINTMENT DATE/TIME
- S SDT=Y
- S X=SDCODT
- D ^%DT ; GET FM FORMAT FOR CHECKOUT DATE/TIME
- ;ChecOut time cannot be in the future
- S SDCODT=Y
- I SDCODT>$$HTFM^XLFDT($H) D ERR("Check Out time cannot be in the future.") Q
- ;
- ;appointment record
- S BSDXNOD=^BSDXAPPT(BSDXAPTID,0)
- ;make sure CHECKOUT time is after CHECKIN time
- I SDCODT<=$P(BSDXNOD,U,3) D ERR("Check Out time must be at least 1 minute after the Check In time of "_$TR($$FMTE^XLFDT($P(BSDXNOD,U,3)),"@"," ")_".") Q
- ;Hospital Location of RESOURCE
- S BSDXRES=$P(BSDXNOD,U,7) ;RESOURCEID
- S BSDXNOD=^BSDXRES(BSDXRES,0)
- S SDCL=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
- ;
- S SDDA=0
- S SDASK=0
- S SDCOALBF=""
- S SDCOACT="CO"
- S SDLNE=""
- S SDQUIET=1
- K APIERR
- S APIERR=0
- D CO^BSDX25A(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOACT,SDLNE,.SDCOALBF,BSDXAPTID,SDQUIET,VPRV,.APIERR) ;Appt Check Out
- ;ERROR(S) FOUND
- I APIERR>0 D
- . S CNT=""
- . F S CNT=$O(APIERR(CNT),1,ERR) Q:CNT="" S BSDXI=BSDXI+1 D ERR(ERR)
- ;NO ERROR
- I APIERR<1 D
- . S BSDXI=BSDXI+1
- . S ^BSDXTMP($J,BSDXI)="0"_$C(30)
- . S BSDXI=BSDXI+1
- . S ^BSDXTMP($J,BSDXI)=$C(31)
- Q
- ;
- ;CHECK OUT APPOINTMENT - RPC
- CANCKOUT(BSDXY,BSDXAPTID) ;EP Check Out appointment
- ; Returns BSDXY
- ; Input -- BSDXAPTID - Appointment ID
- ; called by BSDX CANCEL CHECKOUT APPT remote procedure
- ;SETUP ERROR TRACKING
- D ^XBKVAR S X="ERROR^BSDX25",@^%ZOSF("TRAP")
- S BSDXI=0
- K ^BSDXTMP($J)
- S BSDXY="^BSDXTMP("_$J_")"
- S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
- I '+BSDXAPTID D ERR("Invalid Appointment ID.") Q
- I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR("Invalid Appointment ID.") Q
- S BSDXNOD=^BSDXAPPT(BSDXAPTID,0)
- S APS=$P(BSDXNOD,U,19)
- S DFN=$P(BSDXNOD,U,5)
- S SDT=$P(BSDXNOD,U)
- S RES=$P(BSDXNOD,U,7)
- S SDCL=$P(^BSDXRES(RES,0),U,4)
- I $P(BSDXNOD,U,14)="" D ERR("Appointment is not Checked Out.") Q
- ; ^BSDXAPPT: update piece 8: Data Entry Clerk; clear piece 14: CHECKOUT;
- S DIE="^BSDXAPPT("
- S DA=BSDXAPTID
- S DR=".14////@;.08///"_DUZ
- D ^DIE
- ; ^SC file 44: clear piece C;3: CHECKED OUT; clear piece C;4: CHECK OUT USER; clear C;6: CHECK OUT ENTERED
- S DIE="^SC("_SDCL_",""S"","_SDT_",1,"
- S DA(2)=SDCL,DA(1)=SDT,(DA,SDN)=$$SCIEN^BSDU2(DFN,SDCL,SDT)
- S DR="303///@;304///@;306///@"
- D ^DIE
- ; ^AUPNVSIT file 9000010: clear piece 18: CHECK OUT DATE&TIME
- S SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
- S SDV=$$GET1^DIQ(409.68,SDOE,.05,"I")
- I +SDV D
- . S DIE="^AUPNVSIT(",DA=SDV
- . S DR=".18///@"
- . D ^DIE S AUPNVSIT=SDV D MOD^AUPNVSIT
- ; ^SCE file 409.68: Set piece 12 back to CHECKED IN, pointer to APPOINTMENT STATUS file 409.63; clear piece 7: CHECK OUT PROCESS COMPLETION
- I +APS D
- . S DIE=409.68,DA=SDOE,DR=".07///@;.12///"_APS
- . D ^DIE
- S BSDXI=BSDXI+1
- S ^BSDXTMP($J,BSDXI)="0"_$C(30)
- S BSDXI=BSDXI+1
- S ^BSDXTMP($J,BSDXI)=$C(31)
- Q
- ;
- ERROR ;
- D ERR("RPMS Error")
- Q
- ;
- ERR(ERRNO) ;Error processing
- I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
- E S BSDXERR=ERRNO
- S BSDXI=BSDXI+1
- S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
- S BSDXI=BSDXI+1
- S ^BSDXTMP($J,BSDXI)=$C(31)
- Q
- BSDX25 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
- +1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
- +2 ;
- +3 ;
- CHECKIND(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG,BSDXCR) ;EP
- +1 ;Entry point for debugging
- +2 ;
- +3 ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))
- +4 ;E G ENDBG
- +5 QUIT
- +6 ;
- CHECKIN(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG,BSDXCR,BSDXPCC,BSDXWHF) ;EP Check in appointment
- +1 ;
- +2 ; INPUT: BSDXAPTID - Appointment ID
- +3 ; BSDXCDT - Check-in date/time. ("@" - indicates delete check-in)
- +4 ; BSDXCC -
- +5 ; BSDXPRV -
- +6 ; BSDXROU - Print Routing Slip flag
- +7 ; BSDXVCL -
- +8 ; BSDXVFM -
- +9 ; BSDXOG -
- +10 ; BSDXCR - Generate Chart request upon check-in? (1-Yes, otherwise no)
- +11 ; BSDXPCC - ien of PWH Type in HEALTH SUMMARY PWH TYPE file ^APCHPWHT
- +12 ; BSDXWHF - Print Patient Wellness Handout flag
- +13 ;
- ENDBG ;
- +1 NEW BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXZ,BSDXIENS,BSDXVEN
- +2 NEW BSDXNOEV,BSDXCAN,EMSG
- +3 SET EMSG=""
- +4 ;Don't execute protocol
- SET BSDXNOEV=1
- +5 SET BSDXCAN=0
- +6 ;
- +7 DO ^XBKVAR
- SET X="ERROR^BSDX25"
- SET @^%ZOSF("TRAP")
- +8 SET BSDXI=0
- +9 KILL ^BSDXTMP($JOB)
- +10 SET BSDXY="^BSDXTMP("_$JOB_")"
- +11 SET ^BSDXTMP($JOB,0)="T00020ERRORID^T00150MESSAGE"_$CHAR(30)
- +12 IF '+BSDXAPTID
- DO ERR("Invalid Appointment ID")
- QUIT
- +13 IF '$DATA(^BSDXAPPT(BSDXAPTID,0))
- DO ERR("Invalid Appointment ID")
- QUIT
- +14 ;
- +15 IF BSDXCDT="@"
- SET BSDXCAN=1
- +16 IF BSDXCDT["@0000"
- SET BSDXCDT=$PIECE(BSDXCDT,"@")
- +17 SET %DT="T"
- SET X=BSDXCDT
- DO ^%DT
- SET BSDXCDT=Y
- +18 IF '$GET(BSDXCAN)
- IF BSDXCDT=-1
- DO ERR(70)
- QUIT
- +19 IF BSDXCDT>$$NOW^XLFDT
- SET BSDXCDT=$$NOW^XLFDT
- +20 SET BSDXCDT=$PIECE(BSDXCDT,".",1)_"."_$EXTRACT($PIECE(BSDXCDT,".",2),1,4)
- +21 SET BSDXNOD=^BSDXAPPT(BSDXAPTID,0)
- +22 SET DFN=$PIECE(BSDXNOD,U,5)
- +23 SET BSDXPATID=$PIECE(BSDXNOD,U,5)
- +24 SET BSDXSTART=$PIECE(BSDXNOD,U)
- +25 ;
- +26 ;RESOURCEID
- SET BSDXSC1=$PIECE(BSDXNOD,U,7)
- +27 ;if resourceId is not null AND there is a valid resource record
- +28 IF BSDXSC1]""
- IF $DATA(^BSDXRES(BSDXSC1,0))
- Begin DoDot:1
- +29 SET BSDXNOD=^BSDXRES(BSDXSC1,0)
- +30 ;HOSPITAL LOCATION
- SET BSDXSC1=$PIECE(BSDXNOD,U,4)
- +31 ;Hospital Location is required for CHECKIN
- +32 IF 'BSDXSC1]""
- IF '$DATA(^SC(+BSDXSC1,0))
- DO ERR("RPMS Clinic not defined for this Resource: "_$PIECE(BSDXNOD,U,1)_" ("_BSDXSC1_")")
- QUIT
- +33 ;Checkin BSDX APPOINTMENT entry
- +34 ; sets field .03 (Checkin), in file 9002018.4
- DO BSDXCHK(BSDXAPTID,$SELECT(BSDXCAN:"",1:BSDXCDT))
- +35 ;Process cancel checkin
- +36 IF $GET(BSDXCAN)
- DO CANCHKIN(BSDXPATID,BSDXSC1,BSDXSTART)
- QUIT
- +37 DO APCHK(.BSDXZ,BSDXSC1,BSDXPATID,BSDXCDT,BSDXSTART,BSDXCC,BSDXPRV,BSDXVCL,BSDXVFM,BSDXOG)
- +38 IF $GET(BSDXPRV)
- SET DIE="^BSDXAPPT("
- SET DA=BSDXAPTID
- SET DR=".16///"_BSDXPRV
- DO ^DIE
- +39 ;S DGQUIET=1
- +40 ;print routing slip
- IF $GET(BSDXROU)="true"
- DO WISD^BSDX42(DFN,$PIECE(BSDXCDT,"."),"SD",,,.EMSG)
- +41 ;print PCC health summary
- IF $GET(BSDXPCC)'=""
- DO WISD^BSDX43(DFN,$PIECE(BSDXCDT,"."),"SD",BSDXPCC,.EMSG)
- +42 ;print patient wellness handout
- IF $GET(BSDXWHF)="true"
- DO WISDW^BSDX42(DFN,$PIECE(BSDXCDT,"."),.EMSG)
- +43 IF $GET(BSDXCR)
- IF $$GET1^DIQ(9002018.4,BSDXAPTID,.13)="YES"
- Begin DoDot:2
- +44 SET BSDXDEV=$$GET1^DIQ(9009020.2,$$DIV^BSDU,.05)
- IF BSDXDEV=""
- DO ERR("Chart request failed - No default file room printer found.")
- QUIT
- +45 SET DGQUIET=1
- DO WISD^BSDROUT(BSDXPATID,$PIECE(BSDXSTART,"."),"",BSDXDEV)
- End DoDot:2
- End DoDot:1
- IF +$GET(BSDXZ)
- DO ERR($PIECE(BSDXZ,U,2))
- QUIT
- +46 ;
- +47 SET BSDXI=BSDXI+1
- +48 SET ^BSDXTMP($JOB,BSDXI)="0^"_$SELECT(EMSG'="":EMSG,1:"")_$CHAR(30)
- +49 SET BSDXI=BSDXI+1
- +50 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
- +51 QUIT
- +52 ;
- BSDXCHK(BSDXAPTID,BSDXCDT) ;
- +1 ;
- +2 SET BSDXIENS=BSDXAPTID_","
- +3 SET BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT
- +4 DO FILE^DIE("","BSDXFDA","BSDXMSG")
- +5 QUIT
- +6 ;
- APCHK(BSDXZ,BSDXSC1,BSDXDFN,BSDXCDT,BSDXSTART,BSDXCC,BSDXPRV,BSDXVCL,BSDXVFM,BSDXOG) ;
- +1 ;Checkin appointment for patient BSDXDFN in clinic BSDXSC1
- +2 ;at time BSDXSD
- +3 NEW BSDXC,BSDXOUT,IEN
- +4 ; BSDR("PAT") = ien of patient in file 2
- +5 ; BSDR("CLN") = ien of clinic in file 44
- +6 ; BSDR("ADT") = appt date/time
- +7 ; BSDR("CDT") = checkin date/time
- +8 ; BSDR("USR") = checkin user
- +9 SET BSDXC("PAT")=BSDXDFN
- +10 ;S BSDXC("CLN")=BSDXSC1
- +11 SET BSDXC("HOS LOC")=BSDXSC1
- +12 ;S BSDXC("CC")=BSDXCC
- +13 SET BSDXC("CLINIC CODE")=$GET(BSDXCC)
- +14 ;S BSDXC("PRV")=$G(BSDXPRV)
- +15 SET BSDXC("PROVIDER")=$GET(BSDXPRV)
- +16 ;S BSDXC("ADT")=BSDXSTART
- +17 SET BSDXC("APPT DATE")=BSDXSTART
- +18 SET BSDXC("CDT")=BSDXCDT
- +19 SET BSDXC("USR")=DUZ
- +20 ;find IEN in ^SC multiple or null
- +21 SET APTN=$$FIND^SDAM2(BSDXC("PAT"),BSDXC("APPT DATE"),BSDXC("HOS LOC"))
- +22 ;
- +23 ;Required by NEW API:
- +24 SET BSDXC("TIME RANGE")=-1
- +25 ;IHS/HMW **1** 20060419
- SET BSDXC("VISIT DATE")=BSDXCDT
- +26 SET BSDXC("SITE")=$GET(DUZ(2))
- +27 SET BSDXC("VISIT TYPE")=$$GET1^DIQ(9001001.2,BSDXC("SITE"),.11,"I")
- +28 IF BSDXC("VISIT TYPE")=""
- SET BSDXC("VISIT TYPE")=$$GET1^DIQ(9001000,BSDXC("SITE"),.04,"I")
- +29 IF BSDXC("VISIT TYPE")=""
- SET BSDXC("VISIT TYPE")="I"
- +30 SET BSDXC("SRV CAT")=$$GET1^DIQ(9001001.2,BSDXC("SITE"),.12,"I")
- +31 IF BSDXC("SRV CAT")=""
- SET BSDXC("SRV CAT")="A"
- +32 ;TELL LINDA ABOUT THESE 2 -- SAME VARIABLES WITH DIFFERENT NAMES
- +33 SET BSDXC("CLN")=BSDXC("HOS LOC")
- +34 SET BSDXC("ADT")=BSDXC("APPT DATE")
- +35 ;
- +36 ;Set up BSDXVEN array containing VEN EHP CLINIC, VEN EHP FORM, OUTGUIDE FLAG
- +37 ;These values come from input param
- +38 SET BSDXVEN("CLINIC")=$GET(BSDXVCL)
- +39 SET BSDXVEN("FORM")=$GET(BSDXVFM)
- +40 SET BSDXVEN("OUTGUIDE")=$GET(BSDXOG)
- +41 ;
- +42 ;walk-in vs appt
- SET BSDXC("APCDAPPT")=$SELECT($PIECE(^DPT(BSDXC("PAT"),"S",BSDXC("APPT DATE"),0),U,7)=3:"A",$PIECE(^DPT(BSDXC("PAT"),"S",BSDXC("APPT DATE"),0),U,7)=4:"W",1:"U")
- +43 ;not needed for phone calls & chart reviews
- IF "CT"[BSDXC("SRV CAT")
- KILL BSDXC("APCDAPPT")
- +44 SET BSDXC("APCDOPT")=$ORDER(^DIC(19,"B","SD IHS PCC LINK",0))
- +45 ;find appt
- SET IEN=$$SCIEN^BSDU2(BSDXC("PAT"),BSDXC("HOS LOC"),BSDXC("APPT DATE"))
- +46 ; set checkin
- +47 KILL DIE,DA,DR
- +48 SET DIE="^SC("_BSDXC("HOS LOC")_",""S"","_BSDXC("APPT DATE")_",1,"
- +49 SET DA(2)=BSDXC("HOS LOC")
- SET DA(1)=BSDXC("APPT DATE")
- SET DA=IEN
- +50 SET DR="309///"_BSDXC("VISIT DATE")_";302///`"_BSDXC("USR")_";305///"_$$NOW^XLFDT
- +51 DO ^DIE
- +52 ;don't create visit
- IF $$GET1^DIQ(9009017.2,+BSDXC("HOS LOC"),.09)'="YES"
- QUIT
- +53 SET BSDXC("CALLER")="BSD CHECKIN"
- +54 ;call to check for existing visit and checkin appt; checkin appt should create visit if needed
- DO GETVISIT^BSDAPI4(.BSDXC,.BSDXOUT)
- +55 ;if we came back with at least 1 existing visit, we are done; otherwise we need to create a visit.
- +56 IF 'BSDXOUT(0)
- Begin DoDot:1
- +57 SET BSDXC("FORCE ADD")=1
- +58 DO GETVISIT^BSDAPI4(.BSDXC,.BSDXOUT)
- End DoDot:1
- +59 ;
- +60 ; add provider to visit
- +61 IF $GET(BSDXC("PROVIDER"))
- Begin DoDot:1
- +62 NEW BSDXVSTR,BSDXIEN
- +63 SET BSDXIEN=$ORDER(BSDXOUT(0))
- +64 SET BSDXVSTR=$$VIS2VSTR^BEHOENCX(BSDXC("PAT"),BSDXIEN)
- +65 DO UPDPRV^BEHOENCX(,BSDXC("PAT"),BSDXVSTR,BSDXC("PROVIDER"))
- End DoDot:1
- +66 QUIT
- +67 ;
- CANCHKIN(DFN,SDCL,SDT) ; Logic to cancel a checkin if the checkin date/time is passed in as '@'
- +1 ; input: DFN := ifn of patient
- +2 ; SDCL := clinic#
- +3 ; SDT := appt d/t
- +4 ;
- +5 NEW SDDA
- +6 SET SDDA=$$FIND(DFN,SDT,SDCL)
- +7 ;I 'SDDA D ERR("BSDX25: Could not locate appointment in database or appointment is cancelled.") Q
- +8 IF 'SDDA
- DO ERR("Could not locate appointment in database or appointment is cancelled.")
- QUIT
- +9 NEW SDATA,SDCIHDL,X
- SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
- SET SDCIHDL=$$HANDLE^SDAMEVT(1)
- +10 DO BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
- +11 SET FDA(44.003,SDDA_","_SDT_","_SDCL_",",309)=""
- DO FILE^DIE(,"FDA","ERR")
- +12 DO AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
- +13 DO CHKEVTD(DFN,SDT,SDCL)
- +14 KILL FDA,ERR
- +15 QUIT
- +16 ;
- FIND(DFN,SDT,SDCL) ; -- return appt ifn for pat
- +1 ; input: DFN := ifn of pat.
- +2 ; SDT := appt d/t
- +3 ; SDCL := ifn of clinic
- +4 ; output: [returned] := ifn if pat has appt on date/time
- +5 ;
- +6 NEW Y
- +7 SET Y=0
- FOR
- SET Y=$ORDER(^SC(SDCL,"S",SDT,1,Y))
- IF 'Y
- QUIT
- IF $DATA(^(Y,0))
- IF DFN=+^(0)
- IF $DATA(^DPT(+DFN,"S",SDT,0))
- IF $$VALID(DFN,SDCL,SDT,Y)
- QUIT
- +8 QUIT Y
- +9 ;
- VALID(DFN,SDCL,SDT,SDDA) ; -- return valid appt.
- +1 ; **NOTE: For speed consideration the ^SC and ^DPT nodes must be
- +2 ; check to see they exist prior to calling this entry point.
- +3 ; input: DFN := ifn of pat.
- +4 ; SDT := appt d/t
- +5 ; SDCL := ifn of clinic
- +6 ; SDDA := ifn of appt
- +7 ; output: [returned] := 1 for valid appt., 0 for not valid
- +8 QUIT $SELECT($PIECE(^SC(SDCL,"S",SDT,1,SDDA,0),U,9)'="C":1,$PIECE(^DPT(DFN,"S",SDT,0),U,2)["C":1,1:0)
- +9 ;
- CHKEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CHECKIN APPOINTMENT event
- +1 ;when appointments CHECKIN via PIMS interface.
- +2 ;Propagates CHECKIN to BSDXAPPT and raises refresh event to running GUI clients
- +3 ;
- +4 IF +$GET(BSDXNOEV)
- QUIT
- +5 IF '+$GET(BSDXSC)
- QUIT
- +6 NEW BSDXSTAT,BSDXFOUND,BSDXRES
- +7 SET BSDXSTAT=""
- +8 IF $GET(SDATA("AFTER","STATUS"))["CHECKED IN"
- SET BSDXSTAT=$PIECE(SDATA("AFTER","STATUS"),"^",4)
- +9 SET BSDXFOUND=0
- +10 IF $DATA(^BSDXRES("ALOC",BSDXSC))
- SET BSDXRES=$ORDER(^BSDXRES("ALOC",BSDXSC,0))
- SET BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
- +11 IF BSDXFOUND
- DO CHKEVT3(BSDXRES)
- QUIT
- +12 IF $DATA(^BXDXRES("ASSOC",BSDXSC))
- SET BSDXRES=$ORDER(^BSDXRES("ASSOC",BSDXSC,0))
- SET BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
- +13 IF BSDXFOUND
- DO CHKEVT3(BSDXRES)
- +14 QUIT
- +15 ;
- CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
- +1 ;Get appointment id in BSDXAPT
- +2 ;If found, call BSDXNOS(BSDXAPPT) and return 1
- +3 ;else return 0
- +4 NEW BSDXFOUND,BSDXAPPT
- +5 SET BSDXFOUND=0
- +6 IF '+$GET(BSDXRES)
- QUIT BSDXFOUND
- +7 IF '$DATA(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART))
- QUIT BSDXFOUND
- +8 SET BSDXAPPT=0
- FOR
- SET BSDXAPPT=$ORDER(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT))
- IF '+BSDXAPPT
- QUIT
- Begin DoDot:1
- +9 SET BSDXNOD=$GET(^BSDXAPPT(BSDXAPPT,0))
- IF BSDXNOD=""
- QUIT
- +10 IF $PIECE(BSDXNOD,U,5)=BSDXPAT
- IF $PIECE(BSDXNOD,U,12)=""
- SET BSDXFOUND=1
- QUIT
- End DoDot:1
- IF BSDXFOUND
- QUIT
- +11 IF BSDXFOUND
- IF +$GET(BSDXAPPT)
- DO BSDXCHK(BSDXAPPT,BSDXSTAT)
- +12 QUIT BSDXFOUND
- +13 ;
- CHKEVT3(BSDXRES) ;
- +1 ;Call RaiseEvent to notify GUI clients
- +2 ;
- +3 NEW BSDXRESN
- +4 SET BSDXRESN=$GET(^BSDXRES(BSDXRES,0))
- +5 IF BSDXRESN=""
- QUIT
- +6 SET BSDXRESN=$PIECE(BSDXRESN,"^")
- +7 ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
- +8 DO EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
- +9 QUIT
- +10 ;
- CHKEVTD(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CHECKIN APPOINTMENT event
- +1 ;when an appointment CHECKIN is deleted via.
- +2 ;Deletes CHECKIN to and raises refresh event to running GUI clients
- +3 ;
- +4 ;
- +5 IF +$GET(BSDXNOEV)
- QUIT
- +6 IF '+$GET(BSDXSC)
- QUIT
- +7 NEW BSDXSTAT,BSDXFOUND,BSDXRES
- +8 SET BSDXSTAT=""
- +9 IF $GET(SDATA("AFTER","STATUS"))'="CHECKED IN"
- SET BSDXSTAT=$PIECE(SDATA("AFTER","STATUS"),"^",4)
- +10 IF BSDXSTAT=""
- SET BSDXRES=$ORDER(^BSDXRES("ALOC",BSDXSC,0))
- +11 IF BSDXRES
- DO CHKEVT3(BSDXRES)
- QUIT
- +12 SET BSDXFOUND=0
- +13 ;
- +14 ;I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
- +15 ;I BSDXFOUND D CHKEVT3(BSDXRES) Q
- +16 ;I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
- +17 ;I BSDXFOUND D CHKEVT3(BSDXRES)
- +18 QUIT
- +19 ;
- +20 ;CHECK OUT APPOINTMENT - RPC
- CHECKOUT(BSDXY,DFN,SDT,SDCODT,BSDXAPTID,VPRV) ;EP Check Out appointment
- +1 ; Returns BSDXY
- +2 ; Input -- DFN Patient file IEN
- +3 ; SDT Appointment Date/Time in FM format
- +4 ; SDCODT Date/Time of Check Out FM FORMAT [REQUIRED]
- +5 ; BSDXAPTID - Appointment ID
- +6 ; VPRV - V Provider
- +7 ; called by BSDX CHECKOUT APPOINTMENT remote procedure
- +8 ;SETUP ERROR TRACKING
- +9 DO ^XBKVAR
- SET X="ERROR^BSDX25"
- SET @^%ZOSF("TRAP")
- +10 SET BSDXI=0
- +11 KILL ^BSDXTMP($JOB)
- +12 SET BSDXY="^BSDXTMP("_$JOB_")"
- +13 SET ^BSDXTMP($JOB,0)="T00020ERRORID"_$CHAR(30)
- +14 IF '+BSDXAPTID
- DO ERR("Invalid Appointment ID.")
- QUIT
- +15 IF '$DATA(^BSDXAPPT(BSDXAPTID,0))
- DO ERR("Invalid Appointment ID.")
- QUIT
- +16 ;INITIALIZE VARIABLES
- +17 SET %DT="T"
- +18 SET X=SDT
- +19 ; GET FM FORMAT FOR APPOINTMENT DATE/TIME
- DO ^%DT
- +20 SET SDT=Y
- +21 SET X=SDCODT
- +22 ; GET FM FORMAT FOR CHECKOUT DATE/TIME
- DO ^%DT
- +23 ;ChecOut time cannot be in the future
- +24 SET SDCODT=Y
- +25 IF SDCODT>$$HTFM^XLFDT($HOROLOG)
- DO ERR("Check Out time cannot be in the future.")
- QUIT
- +26 ;
- +27 ;appointment record
- +28 SET BSDXNOD=^BSDXAPPT(BSDXAPTID,0)
- +29 ;make sure CHECKOUT time is after CHECKIN time
- +30 IF SDCODT<=$PIECE(BSDXNOD,U,3)
- DO ERR("Check Out time must be at least 1 minute after the Check In time of "_$TRANSLATE($$FMTE^XLFDT($PIECE(BSDXNOD,U,3)),"@"," ")_".")
- QUIT
- +31 ;Hospital Location of RESOURCE
- +32 ;RESOURCEID
- SET BSDXRES=$PIECE(BSDXNOD,U,7)
- +33 SET BSDXNOD=^BSDXRES(BSDXRES,0)
- +34 ;HOSPITAL LOCATION
- SET SDCL=$PIECE(BSDXNOD,U,4)
- +35 ;
- +36 SET SDDA=0
- +37 SET SDASK=0
- +38 SET SDCOALBF=""
- +39 SET SDCOACT="CO"
- +40 SET SDLNE=""
- +41 SET SDQUIET=1
- +42 KILL APIERR
- +43 SET APIERR=0
- +44 ;Appt Check Out
- DO CO^BSDX25A(DFN,SDT,SDCL,SDDA,SDASK,SDCODT,SDCOACT,SDLNE,.SDCOALBF,BSDXAPTID,SDQUIET,VPRV,.APIERR)
- +45 ;ERROR(S) FOUND
- +46 IF APIERR>0
- Begin DoDot:1
- +47 SET CNT=""
- +48 FOR
- SET CNT=$ORDER(APIERR(CNT),1,ERR)
- IF CNT=""
- QUIT
- SET BSDXI=BSDXI+1
- DO ERR(ERR)
- End DoDot:1
- +49 ;NO ERROR
- +50 IF APIERR<1
- Begin DoDot:1
- +51 SET BSDXI=BSDXI+1
- +52 SET ^BSDXTMP($JOB,BSDXI)="0"_$CHAR(30)
- +53 SET BSDXI=BSDXI+1
- +54 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
- End DoDot:1
- +55 QUIT
- +56 ;
- +57 ;CHECK OUT APPOINTMENT - RPC
- CANCKOUT(BSDXY,BSDXAPTID) ;EP Check Out appointment
- +1 ; Returns BSDXY
- +2 ; Input -- BSDXAPTID - Appointment ID
- +3 ; called by BSDX CANCEL CHECKOUT APPT remote procedure
- +4 ;SETUP ERROR TRACKING
- +5 DO ^XBKVAR
- SET X="ERROR^BSDX25"
- SET @^%ZOSF("TRAP")
- +6 SET BSDXI=0
- +7 KILL ^BSDXTMP($JOB)
- +8 SET BSDXY="^BSDXTMP("_$JOB_")"
- +9 SET ^BSDXTMP($JOB,0)="T00020ERRORID"_$CHAR(30)
- +10 IF '+BSDXAPTID
- DO ERR("Invalid Appointment ID.")
- QUIT
- +11 IF '$DATA(^BSDXAPPT(BSDXAPTID,0))
- DO ERR("Invalid Appointment ID.")
- QUIT
- +12 SET BSDXNOD=^BSDXAPPT(BSDXAPTID,0)
- +13 SET APS=$PIECE(BSDXNOD,U,19)
- +14 SET DFN=$PIECE(BSDXNOD,U,5)
- +15 SET SDT=$PIECE(BSDXNOD,U)
- +16 SET RES=$PIECE(BSDXNOD,U,7)
- +17 SET SDCL=$PIECE(^BSDXRES(RES,0),U,4)
- +18 IF $PIECE(BSDXNOD,U,14)=""
- DO ERR("Appointment is not Checked Out.")
- QUIT
- +19 ; ^BSDXAPPT: update piece 8: Data Entry Clerk; clear piece 14: CHECKOUT;
- +20 SET DIE="^BSDXAPPT("
- +21 SET DA=BSDXAPTID
- +22 SET DR=".14////@;.08///"_DUZ
- +23 DO ^DIE
- +24 ; ^SC file 44: clear piece C;3: CHECKED OUT; clear piece C;4: CHECK OUT USER; clear C;6: CHECK OUT ENTERED
- +25 SET DIE="^SC("_SDCL_",""S"","_SDT_",1,"
- +26 SET DA(2)=SDCL
- SET DA(1)=SDT
- SET (DA,SDN)=$$SCIEN^BSDU2(DFN,SDCL,SDT)
- +27 SET DR="303///@;304///@;306///@"
- +28 DO ^DIE
- +29 ; ^AUPNVSIT file 9000010: clear piece 18: CHECK OUT DATE&TIME
- +30 SET SDOE=$$GETAPT^SDVSIT2(DFN,SDT,SDCL)
- +31 SET SDV=$$GET1^DIQ(409.68,SDOE,.05,"I")
- +32 IF +SDV
- Begin DoDot:1
- +33 SET DIE="^AUPNVSIT("
- SET DA=SDV
- +34 SET DR=".18///@"
- +35 DO ^DIE
- SET AUPNVSIT=SDV
- DO MOD^AUPNVSIT
- End DoDot:1
- +36 ; ^SCE file 409.68: Set piece 12 back to CHECKED IN, pointer to APPOINTMENT STATUS file 409.63; clear piece 7: CHECK OUT PROCESS COMPLETION
- +37 IF +APS
- Begin DoDot:1
- +38 SET DIE=409.68
- SET DA=SDOE
- SET DR=".07///@;.12///"_APS
- +39 DO ^DIE
- End DoDot:1
- +40 SET BSDXI=BSDXI+1
- +41 SET ^BSDXTMP($JOB,BSDXI)="0"_$CHAR(30)
- +42 SET BSDXI=BSDXI+1
- +43 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
- +44 QUIT
- +45 ;
- ERROR ;
- +1 DO ERR("RPMS Error")
- +2 QUIT
- +3 ;
- ERR(ERRNO) ;Error processing
- +1 ;vbObjectError
- IF +ERRNO
- SET BSDXERR=ERRNO+134234112
- +2 IF '$TEST
- SET BSDXERR=ERRNO
- +3 SET BSDXI=BSDXI+1
- +4 SET ^BSDXTMP($JOB,BSDXI)=BSDXERR_$CHAR(30)
- +5 SET BSDXI=BSDXI+1
- +6 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
- +7 QUIT