- SDES2BLOCKPBSP ;ALB/BLB - SDES2 BLOCK PBSP CLINIC AVAIL; FEB 27 2024 11:30 AM
- ;;5.3;Scheduling;**875**;Aug 13, 1993;Build 25
- ;;Per VHA Directive 6402, this routine should not be modified
- ;
- Q
- ;
- BLOCK(JSON,SDCONTEXT,BLOCK) ;
- N ERRORS,PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP,RETURN
- ;
- D POPULATE(.BLOCK,.PBSPID,.STARTDATETIME,.ENDDATETIME,.CLINICIENTOSKIP)
- D VALIDATE(.ERRORS,.SDCONTEXT,$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,SDCONTEXT,PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP) ;
- D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
- I $D(ERRORS) Q
- ;
- 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 2707 printed Feb 19, 2025@00:19:50 Page 2
- SDES2BLOCKPBSP ;ALB/BLB - SDES2 BLOCK PBSP CLINIC AVAIL; FEB 27 2024 11:30 AM
- +1 ;;5.3;Scheduling;**875**;Aug 13, 1993;Build 25
- +2 ;;Per VHA Directive 6402, this routine should not be modified
- +3 ;
- +4 QUIT
- +5 ;
- BLOCK(JSON,SDCONTEXT,BLOCK) ;
- +1 NEW ERRORS,PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP,RETURN
- +2 ;
- +3 DO POPULATE(.BLOCK,.PBSPID,.STARTDATETIME,.ENDDATETIME,.CLINICIENTOSKIP)
- +4 DO VALIDATE(.ERRORS,.SDCONTEXT,$GET(PBSPID),$GET(STARTDATETIME),$GET(ENDDATETIME),$GET(CLINICIENTOSKIP))
- +5 IF $DATA(ERRORS)
- SET ERRORS("BlockPBSPID")=""
- DO BUILDJSON^SDES2JSON(.JSON,.ERRORS)
- QUIT
- +6 ;
- +7 DO BLOCKSLOTS(PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP,.SDCONTEXT)
- +8 SET RETURN("BlockPBSPID")=1
- +9 DO BUILDJSON^SDES2JSON(.JSON,.RETURN)
- +10 QUIT
- +11 ;
- 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,SDCONTEXT,PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP) ;
- +1 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
- +2 IF $DATA(ERRORS)
- QUIT
- +3 ;
- +4 DO VALFILEIEN^SDES2VALUTIL(,.ERRORS,44,CLINICIENTOSKIP,1,,18,19)
- +5 ;
- +6 SET STARTDATETIME=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,STARTDATETIME,CLINICIENTOSKIP,1,165,166)
- +7 SET ENDDATETIME=$$VALISODTTM^SDES2VALISODTTM(.ERRORS,ENDDATETIME,CLINICIENTOSKIP,1,167,168)
- +8 ;
- +9 IF '$LENGTH($GET(PBSPID))
- DO ERRLOG^SDESJSON(.ERRORS,557)
- QUIT
- +10 IF '$DATA(^SC("PBSP",PBSPID))
- DO ERRLOG^SDESJSON(.ERRORS,556)
- QUIT
- +11 IF $LENGTH(PBSPID)>100
- DO ERRLOG^SDESJSON(.ERRORS,556)
- +12 IF $DATA(ERRORS)
- QUIT
- +13 ;
- +14 IF $$APPTEXISTSINSLOT(PBSPID,STARTDATETIME,ENDDATETIME,CLINICIENTOSKIP)
- DO ERRLOG^SDESJSON(.ERRORS,558)
- +15 QUIT
- +16 ;
- 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 ;
