BSDX37 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
; NS = RETURN NO-SHOW DATA FOR GIVEN PATIENT - RPC
; VAL = return boolean to represent that a clinic allows variable appointment length - RPC
;
;RETURN NO-SHOW DATA FOR GIVEN PATIENT - RPC
NS(BSDXY,DFN,SDCL) ;COLLECT NO-SHOW DATA
; .BSDXY = returned pointer to NO SHOW data
; DFN = patient code - pointer to ^DPT(DFN)
; SDCL = clinic code - pointer to Hospital Location file ^SC
N BSDXI,NSC,SD2,SDCLN,SDT,SDTN
D ^XBKVAR S X="ERROR^BSDX37",@^%ZOSF("TRAP")
S BSDXI=0
K ^BSDXTMP($J)
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
;check for valid resource
I '+DFN D ERR("Invalid Patient ID.") Q
I '$D(^DPT(DFN,0)) D ERR("Invalid Patient ID.") Q
; data header
; TOO_MANY = flag 0=OK; 1=too many no shows
S ^BSDXTMP($J,0)="I00020PATIENT_IEN^I00020CLINIC_IEN^I00020TOO_MANY^I00020ALLOWED_NO_SHOWS^I00020TOTAL_NO_SHOWS"_$C(30)
;get allowed number of no shows for clinic
S SDCLN=$G(^SC(SDCL,"SDP"))
;loop thru schedule
S NSC=0 ;no show counter
S SDT=0
F S SDT=$O(^DPT(DFN,"S",SDT)) Q:SDT'>0 D
. S SDTN=^DPT(DFN,"S",SDT,0)
. I ($P(SDTN,U)=SDCL) D
. . S SD2=$P(SDTN,U,2)
. . I SD2["N",$$NOSHOW(DFN,SDT,$P(SDTN,U),SDTN) S NSC=NSC+1
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=DFN_U_SDCL_U_($P(SDCLN,U,1)<=NSC)_U_$P(SDCLN,U)_U_NSC
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(30)
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
NOSHOW(DFN,SDT,CIFN,PAT) ;Input: DFN=Patient IFN, SDT=Appointment D/T
; CIFN=Clinic IFN, PAT=Zero node of pat. appt., DA=Clinic appt. IFN
; Output: 1 or 0 for noshow yes/no
N NSQUERY,NS S NS=1,NSQUERY=$$STATUS^SDAM1(DFN,SDT,CIFN,PAT)
I $P(NSQUERY,";",3)["ACTION REQ" S NS=0
NOSHOWQ Q NS
;
;return boolean to represent that a clinic allows variable appointment length - RPC
VAL(BSDXY,SDCL) ;return boolean to represent that a clinic allows variable appointment length - RPC
; BSDX CLINIC VAR APPT
N BSDXI
D ^XBKVAR S X="ERROR^BSDX37",@^%ZOSF("TRAP")
S BSDXI=0
K ^BSDXTMP($J)
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
;check for valid clinic ID
I '+SDCL D ERR("Invalid Clinic ID.") Q
I '$D(^SC(SDCL,0)) D ERR("Invalid Clinic ID.") Q
; data header
; VAR_APPT_FLAG = flag 0=Clinic does not Allow Variable Appointment; 1=Clinic Allows Variable Appointment
S ^BSDXTMP($J,0)="I00020VAR_APPT_FLAG"_$C(30)
;get VARIABLE APPOINTMENT FLAG for clinic
S VAL=$$GET1^DIQ(44,SDCL_",",1913) ;Variable Appointment Length
S VAL=$S(VAL["YES":1,1:0)
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=VAL
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(30)
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
ERROR ;
D ERR("RPMS Error")
Q
;
ERR(BSDXERR) ;Error processing
I +BSDXERR S BSDXERR=ERRNO+134234112 ;vbObjectError
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
BSDX37 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ; NS = RETURN NO-SHOW DATA FOR GIVEN PATIENT - RPC
+4 ; VAL = return boolean to represent that a clinic allows variable appointment length - RPC
+5 ;
+6 ;RETURN NO-SHOW DATA FOR GIVEN PATIENT - RPC
NS(BSDXY,DFN,SDCL) ;COLLECT NO-SHOW DATA
+1 ; .BSDXY = returned pointer to NO SHOW data
+2 ; DFN = patient code - pointer to ^DPT(DFN)
+3 ; SDCL = clinic code - pointer to Hospital Location file ^SC
+4 NEW BSDXI,NSC,SD2,SDCLN,SDT,SDTN
+5 DO ^XBKVAR
SET X="ERROR^BSDX37"
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 ;check for valid resource
+11 IF '+DFN
DO ERR("Invalid Patient ID.")
QUIT
+12 IF '$DATA(^DPT(DFN,0))
DO ERR("Invalid Patient ID.")
QUIT
+13 ; data header
+14 ; TOO_MANY = flag 0=OK; 1=too many no shows
+15 SET ^BSDXTMP($JOB,0)="I00020PATIENT_IEN^I00020CLINIC_IEN^I00020TOO_MANY^I00020ALLOWED_NO_SHOWS^I00020TOTAL_NO_SHOWS"_$CHAR(30)
+16 ;get allowed number of no shows for clinic
+17 SET SDCLN=$GET(^SC(SDCL,"SDP"))
+18 ;loop thru schedule
+19 ;no show counter
SET NSC=0
+20 SET SDT=0
+21 FOR
SET SDT=$ORDER(^DPT(DFN,"S",SDT))
IF SDT'>0
QUIT
Begin DoDot:1
+22 SET SDTN=^DPT(DFN,"S",SDT,0)
+23 IF ($PIECE(SDTN,U)=SDCL)
Begin DoDot:2
+24 SET SD2=$PIECE(SDTN,U,2)
+25 IF SD2["N"
IF $$NOSHOW(DFN,SDT,$PIECE(SDTN,U),SDTN)
SET NSC=NSC+1
End DoDot:2
End DoDot:1
+26 SET BSDXI=BSDXI+1
+27 SET ^BSDXTMP($JOB,BSDXI)=DFN_U_SDCL_U_($PIECE(SDCLN,U,1)<=NSC)_U_$PIECE(SDCLN,U)_U_NSC
+28 SET BSDXI=BSDXI+1
+29 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(30)
+30 SET BSDXI=BSDXI+1
+31 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+32 QUIT
+33 ;
NOSHOW(DFN,SDT,CIFN,PAT) ;Input: DFN=Patient IFN, SDT=Appointment D/T
+1 ; CIFN=Clinic IFN, PAT=Zero node of pat. appt., DA=Clinic appt. IFN
+2 ; Output: 1 or 0 for noshow yes/no
+3 NEW NSQUERY,NS
SET NS=1
SET NSQUERY=$$STATUS^SDAM1(DFN,SDT,CIFN,PAT)
+4 IF $PIECE(NSQUERY,";",3)["ACTION REQ"
SET NS=0
NOSHOWQ QUIT NS
+1 ;
+2 ;return boolean to represent that a clinic allows variable appointment length - RPC
VAL(BSDXY,SDCL) ;return boolean to represent that a clinic allows variable appointment length - RPC
+1 ; BSDX CLINIC VAR APPT
+2 NEW BSDXI
+3 DO ^XBKVAR
SET X="ERROR^BSDX37"
SET @^%ZOSF("TRAP")
+4 SET BSDXI=0
+5 KILL ^BSDXTMP($JOB)
+6 SET BSDXY="^BSDXTMP("_$JOB_")"
+7 SET ^BSDXTMP($JOB,0)="T00020ERRORID"_$CHAR(30)
+8 ;check for valid clinic ID
+9 IF '+SDCL
DO ERR("Invalid Clinic ID.")
QUIT
+10 IF '$DATA(^SC(SDCL,0))
DO ERR("Invalid Clinic ID.")
QUIT
+11 ; data header
+12 ; VAR_APPT_FLAG = flag 0=Clinic does not Allow Variable Appointment; 1=Clinic Allows Variable Appointment
+13 SET ^BSDXTMP($JOB,0)="I00020VAR_APPT_FLAG"_$CHAR(30)
+14 ;get VARIABLE APPOINTMENT FLAG for clinic
+15 ;Variable Appointment Length
SET VAL=$$GET1^DIQ(44,SDCL_",",1913)
+16 SET VAL=$SELECT(VAL["YES":1,1:0)
+17 SET BSDXI=BSDXI+1
+18 SET ^BSDXTMP($JOB,BSDXI)=VAL
+19 SET BSDXI=BSDXI+1
+20 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(30)
+21 SET BSDXI=BSDXI+1
+22 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+23 QUIT
+24 ;
ERROR ;
+1 DO ERR("RPMS Error")
+2 QUIT
+3 ;
ERR(BSDXERR) ;Error processing
+1 ;vbObjectError
IF +BSDXERR
SET BSDXERR=ERRNO+134234112
+2 SET BSDXI=BSDXI+1
+3 SET ^BSDXTMP($JOB,BSDXI)=BSDXERR_$CHAR(30)
+4 SET BSDXI=BSDXI+1
+5 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+6 QUIT
+7 ;
