BSDX25.m

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