Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BSDX25

BSDX25.m

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