SDES2BLOCKPBSP ;ALB/BLB,AGW - SDES2 BLOCK PBSP CLINIC AVAIL; July 17, 2025 11:30 AM
;;5.3;Scheduling;**875,909**;Aug 13, 1993;Build 12
;;Per VHA Directive 6402, this routine should not be modified
; Reference to DUZ^XUP is supported by IA #7487
;
Q
;
BLOCK(JSON,SDCONTEXT,BLOCK) ;
N ERRORS,PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP,RETURN
;
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("BlockPBSPID")="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
I $G(SDCONTEXT("USER DUZ"))'="" N DUZ D DUZ^XUP(SDCONTEXT("USER DUZ"))
;
D POPULATE(.BLOCK,.PBSPID,.STARTDATETIME,.ENDDATETIME,.CLINICIENTOSKIP)
D VALIDATE(.ERRORS,$G(PBSPID),$G(STARTDATETIME),$G(ENDDATETIME),$G(CLINICIENTOSKIP))
I $D(ERRORS) S ERRORS("BlockPBSPID")="" D BUILDJSON^SDES2JSON(.JSON,.ERRORS) Q
;
D BLOCKSLOTS(PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP,.SDCONTEXT)
S RETURN("BlockPBSPID")=1
D BUILDJSON^SDES2JSON(.JSON,.RETURN)
Q
;
BLOCKSLOTS(PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP,SDCONTEXT) ;
N CLINICIEN,CANCEL,CANCELJSON
;
S CLINICIEN=0
F S CLINICIEN=$O(^SC("PBSP",PBSPID,CLINICIEN)) Q:'CLINICIEN D
.I CLINICIEN=CLINICIENTOSKIP Q
.S CANCEL("CLINIC IEN")=CLINICIEN
.S CANCEL("FULL PARTIAL FLAG")="P"
.S CANCEL("START DATE TIME")=STARTDATETIME
.S CANCEL("END DATE TIME")=ENDDATETIME
.D CANCEL^SDES2CANCLNAVAIL(.CANCELJSON,.SDCONTEXT,.CANCEL)
Q
;
APPTEXISTSINSLOT(PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP) ;
N DATETIME,FOUND,SUBIEN,CLINICIEN
;
S CLINICIEN=0,FOUND=0
F S CLINICIEN=$O(^SC("PBSP",PBSPID,CLINICIEN)) Q:'CLINICIEN D
.I CLINICIEN=CLINICIENTOSKIP Q
.S DATETIME=STARTDATETIME-.0001
.F S DATETIME=$O(^SC(CLINICIEN,"S",DATETIME)) Q:'DATETIME!(FOUND)!(DATETIME>ENDDATETIME) D
..S SUBIEN=0
..F S SUBIEN=$O(^SC(CLINICIEN,"S",DATETIME,1,SUBIEN)) Q:'SUBIEN!(FOUND) D
...I $$GET1^DIQ(44.003,SUBIEN_","_STARTDATETIME_","_CLINICIEN_",",310,"E")'="CANCELLED" D
....S FOUND=1
Q FOUND
;
VALIDATE(ERRORS,PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP) ;
;
D VALFILEIEN^SDES2VALUTIL(,.ERRORS,44,CLINICIENTOSKIP,1,,18,19)
;
S STARTDATETIME=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,STARTDATETIME,CLINICIENTOSKIP,1,165,166)
S ENDDATETIME=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,ENDDATETIME,CLINICIENTOSKIP,1,167,168)
;
I '$L($G(PBSPID)) D ERRLOG^SDESJSON(.ERRORS,557) Q
I '$D(^SC("PBSP",PBSPID)) D ERRLOG^SDESJSON(.ERRORS,556) Q
I $L(PBSPID)>100 D ERRLOG^SDESJSON(.ERRORS,556)
I $D(ERRORS) Q
;
I $$APPTEXISTSINSLOT(PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP) D ERRLOG^SDESJSON(.ERRORS,558)
Q
;
POPULATE(BLOCK,PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP) ;
S PBSPID=$G(BLOCK("PBSPID"))
S STARTDATETIME=$G(BLOCK("START DATE TIME"))
S ENDDATETIME=$G(BLOCK("END DATE TIME"))
S CLINICIENTOSKIP=$G(BLOCK("APPOINTMENT IN CLINIC"))
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2BLOCKPBSP 2887 printed May 25, 2026@12:57:45 Page 2
SDES2BLOCKPBSP ;ALB/BLB,AGW - SDES2 BLOCK PBSP CLINIC AVAIL; July 17, 2025 11:30 AM
+1 ;;5.3;Scheduling;**875,909**;Aug 13, 1993;Build 12
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ; Reference to DUZ^XUP is supported by IA #7487
+4 ;
+5 QUIT
+6 ;
BLOCK(JSON,SDCONTEXT,BLOCK) ;
+1 NEW ERRORS,PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP,RETURN
+2 ;
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 IF $DATA(ERRORS)
SET ERRORS("BlockPBSPID")=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+5 IF $GET(SDCONTEXT("USER DUZ"))'=""
NEW DUZ
DO DUZ^XUP(SDCONTEXT("USER DUZ"))
+6 ;
+7 DO POPULATE(.BLOCK,.PBSPID,.STARTDATETIME,.ENDDATETIME,.CLINICIENTOSKIP)
+8 DO VALIDATE(.ERRORS,$GET(PBSPID),$GET(STARTDATETIME),$GET(ENDDATETIME),$GET(CLINICIENTOSKIP))
+9 IF $DATA(ERRORS)
SET ERRORS("BlockPBSPID")=""
DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
QUIT
+10 ;
+11 DO BLOCKSLOTS(PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP,.SDCONTEXT)
+12 SET RETURN("BlockPBSPID")=1
+13 DO BUILDJSON^SDES2JSON(.JSON,.RETURN)
+14 QUIT
+15 ;
BLOCKSLOTS(PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP,SDCONTEXT) ;
+1 NEW CLINICIEN,CANCEL,CANCELJSON
+2 ;
+3 SET CLINICIEN=0
+4 FOR
SET CLINICIEN=$ORDER(^SC("PBSP",PBSPID,CLINICIEN))
if 'CLINICIEN
QUIT
Begin DoDot:1
+5 IF CLINICIEN=CLINICIENTOSKIP
QUIT
+6 SET CANCEL("CLINIC IEN")=CLINICIEN
+7 SET CANCEL("FULL PARTIAL FLAG")="P"
+8 SET CANCEL("START DATE TIME")=STARTDATETIME
+9 SET CANCEL("END DATE TIME")=ENDDATETIME
+10 DO CANCEL^SDES2CANCLNAVAIL(.CANCELJSON,.SDCONTEXT,.CANCEL)
End DoDot:1
+11 QUIT
+12 ;
APPTEXISTSINSLOT(PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP) ;
+1 NEW DATETIME,FOUND,SUBIEN,CLINICIEN
+2 ;
+3 SET CLINICIEN=0
SET FOUND=0
+4 FOR
SET CLINICIEN=$ORDER(^SC("PBSP",PBSPID,CLINICIEN))
if 'CLINICIEN
QUIT
Begin DoDot:1
+5 IF CLINICIEN=CLINICIENTOSKIP
QUIT
+6 SET DATETIME=STARTDATETIME-.0001
+7 FOR
SET DATETIME=$ORDER(^SC(CLINICIEN,"S",DATETIME))
if 'DATETIME!(FOUND)!(DATETIME>ENDDATETIME)
QUIT
Begin DoDot:2
+8 SET SUBIEN=0
+9 FOR
SET SUBIEN=$ORDER(^SC(CLINICIEN,"S",DATETIME,1,SUBIEN))
if 'SUBIEN!(FOUND)
QUIT
Begin DoDot:3
+10 IF $$GET1^DIQ(44.003,SUBIEN_","_STARTDATETIME_","_CLINICIEN_",",310,"E")'="CANCELLED"
Begin DoDot:4
+11 SET FOUND=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT FOUND
+13 ;
VALIDATE(ERRORS,PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP) ;
+1 ;
+2 DO VALFILEIEN^SDES2VALUTIL(,.ERRORS,44,CLINICIENTOSKIP,1,,18,19)
+3 ;
+4 SET STARTDATETIME=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,STARTDATETIME,CLINICIENTOSKIP,1,165,166)
+5 SET ENDDATETIME=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,ENDDATETIME,CLINICIENTOSKIP,1,167,168)
+6 ;
+7 IF '$LENGTH($GET(PBSPID))
DO ERRLOG^SDESJSON(.ERRORS,557)
QUIT
+8 IF '$DATA(^SC("PBSP",PBSPID))
DO ERRLOG^SDESJSON(.ERRORS,556)
QUIT
+9 IF $LENGTH(PBSPID)>100
DO ERRLOG^SDESJSON(.ERRORS,556)
+10 IF $DATA(ERRORS)
QUIT
+11 ;
+12 IF $$APPTEXISTSINSLOT(PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP)
DO ERRLOG^SDESJSON(.ERRORS,558)
+13 QUIT
+14 ;
POPULATE(BLOCK,PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP) ;
+1 SET PBSPID=$GET(BLOCK("PBSPID"))
+2 SET STARTDATETIME=$GET(BLOCK("START DATE TIME"))
+3 SET ENDDATETIME=$GET(BLOCK("END DATE TIME"))
+4 SET CLINICIENTOSKIP=$GET(BLOCK("APPOINTMENT IN CLINIC"))
+5 QUIT
+6 ;
