SDES2INACTCLIN ;ALB/TJB,MGD - Inactivate Clinic in HOSPITAL LOCATION FILE 44 ;Mar 18, 2024
;;5.3;Scheduling;**864,877**;Aug 13, 1993;Build 14
;;Per VHA Directive 6402, this routine should not be modified
;
; Documented API's and Integration Agreements
; -------------------------------------------
;Reference to $$GETS^DIQ is supported by IA #2056
;Reference to $$GETS1^DIQ is supported by IA #2056
;
Q
;
SDINACTCLN(SDRETURN,SDCONTEXT,SDPARAM) ;Inactivate Clinic
;INPUT -
; SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
; SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
; SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
; SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
; SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
;
; SDPARAM("CLINIC IEN")=CLINIC IEN IEN of the clinic in file 44 - Hospital location
; SDPARAM("INACTIVATION DATE")=DATE ISO DATE to inactivate the clinic if empty default to today (DT)
;
;RETURN PARMETER:
; Status
;
N ERRORS,RESULTS,CLINICIEN,INACTDATE
; validate context array
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("ClinicInactivate",1)="" D BUILDJSON^SDES2JSON(.SDRETURN,.ERRORS) Q
D VALCLINIEN^SDES2VAL44(.ERRORS,$G(SDPARAM("CLINIC IEN")),1)
I $D(ERRORS) S ERRORS("ClinicInactivate",1)="" D BUILDJSON^SDES2JSON(.SDRETURN,.ERRORS) Q
D INIT(.SDPARAM,.CLINICIEN,.INACTDATE)
D VALIDATE(.ERRORS,INACTDATE,CLINICIEN)
D NOAPPOINTMENTS(CLINICIEN,INACTDATE,.ERRORS)
I $D(ERRORS) D BUILDJSON^SDES2JSON(.SDRETURN,.ERRORS) Q
; File the inactivation on HOSPITAL LOCATION
D BLDCINREC(.RESULTS,CLINICIEN,INACTDATE,.ERRORS)
; If the Clinic was inactivated then update the SDEC RESOURCE (409.831) with the inactivation information
I '$D(ERRORS) D UPDATECLNRES(CLINICIEN,INACTDATE,$G(SDCONTEXT("USER DUZ")),.ERRORS)
I $D(ERRORS) D BUILDJSON^SDES2JSON(.SDRETURN,.ERRORS) Q ; There was a problem updating 409.831 with the inactivation
D ENCODE^SDES2JSON(.RESULTS,.SDRETURN)
Q
;
INIT(SDPARAM,CLINICIEN,INACTDATE) ; initialize values needed
S CLINICIEN=$G(SDPARAM("CLINIC IEN"))
S INACTDATE=$G(SDPARAM("INACTIVATION DATE"))
; If no Inactivation Date then default it to today
I INACTDATE="" S INACTDATE=$$FMTISO^SDAMUTDT(DT)
Q
;
VALIDATE(ERRORS,INACTIVEDATE,CLINICIEN) ; validate incoming parameters
N FMDATE
; Validate the inactivation date
S FMDATE=$$ISOTFM^SDAMUTDT(INACTIVEDATE)
I FMDATE=-1 D ERRLOG^SDES2JSON(.ERRORS,46,"For Clinic Inactivation")
I FMDATE>0,(FMDATE<DT) D ERRLOG^SDES2JSON(.ERRORS,46,"Clinic Inactivation can't be before today")
I (FMDATE>$$FMADD^XLFDT(DT,182)) D ERRLOG^SDES2JSON(.ERRORS,46,"Inactivation Date greater than 6 Months in the future")
Q
; Make sure there are no active appointments after the inactivation date
NOAPPOINTMENTS(CLINICIEN,INACTDATE,ERRORS) ;
N POP,FMDATE,DATEIDX,LASTDATE,I1
S FMDATE=$$ISOTFM^SDAMUTDT($G(INACTDATE))
S CLINICIEN=$G(CLINICIEN)
S POP=0,LASTDATE=9999999,DATEIDX=FMDATE-.0001
F S DATEIDX=$O(^SC(CLINICIEN,"S",DATEIDX)) Q:'DATEIDX!(POP)!(FMDATE'<LASTDATE&(LASTDATE)) D
. S I1=0 F S I1=$O(^SC(CLINICIEN,"S",DATEIDX,1,I1)) Q:'I1 I $$GET1^DIQ(44.003,I1_","_DATEIDX_","_CLINICIEN_",",310,"I")'="C" S POP=1,FMDATE=DATEIDX Q
I POP D ERRLOG^SDES2JSON(.ERRORS,521)
Q
;
BLDCINREC(SDCINREC,CLINICIEN,INACTIVEDATE,ERRORS) ;Inactivate Clinic
; If the inactivation was filed in FILEMAN, no errors recorded, otherwise populate ERRORS
N SDERR,SDFDA,SDCLNNAME,FMDATE
S SDCLNNAME=""
S FMDATE=$$ISOTFM^SDAMUTDT(INACTIVEDATE)
S SDCLNNAME=$$GET1^DIQ(44,CLINICIEN,.01)
S SDFDA(44,CLINICIEN_",",2505)=FMDATE
D UPDATE^DIE("","SDFDA","","SDERR")
I $G(SDERR) D ERRLOG^SDES2JSON(.ERRORS,81) Q
S SDCINREC("ClinicInactivate",1)="Clinic is successfully inactivated."
Q
;
UPDATECLNRES(SDCLINICIEN,INACTIVATIONDATE,SDDUZ,ERRORS) ;Update INACTIVATED DATE/TIME and INACTIVATED BY USER in SDEC RESOURCE File #409.831
N SDRESFDA,SDCLINRES,SDERR,FMDATE
S SDCLINRES=$$GETRES^SDES2UTIL1(SDCLINICIEN,1)
Q:SDCLINRES="" ; no resource associated with clinic
S FMDATE=$$ISOTFM^SDAMUTDT(INACTIVATIONDATE)
S SDRESFDA(409.831,SDCLINRES_",",.021)=$P(FMDATE,".")
S SDRESFDA(409.831,SDCLINRES_",",.022)=$S(SDDUZ'="":SDDUZ,1:DUZ)
D FILE^DIE("","SDRESFDA","SDERR")
I $D(SDERR) D ERRLOG^SDES2JSON(.ERRORS,81,"File 409.831 not updated with the inactivation date for Resource IEN="_SDCLINRES)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2INACTCLIN 4650 printed Nov 22, 2024@18:04:18 Page 2
SDES2INACTCLIN ;ALB/TJB,MGD - Inactivate Clinic in HOSPITAL LOCATION FILE 44 ;Mar 18, 2024
+1 ;;5.3;Scheduling;**864,877**;Aug 13, 1993;Build 14
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Documented API's and Integration Agreements
+5 ; -------------------------------------------
+6 ;Reference to $$GETS^DIQ is supported by IA #2056
+7 ;Reference to $$GETS1^DIQ is supported by IA #2056
+8 ;
+9 QUIT
+10 ;
SDINACTCLN(SDRETURN,SDCONTEXT,SDPARAM) ;Inactivate Clinic
+1 ;INPUT -
+2 ; SDCONTEXT("ACHERON AUDIT ID") = Up to 40 Character unique ID number. Ex: 11d9dcc6-c6a2-4785-8031-8261576fca37
+3 ; SDCONTEXT("PATIENT DFN") = The DFN/IEN of the target patient from the calling application.
+4 ; SDCONTEXT("PATIENT ICN") = The ICN of the target patient from the calling application.
+5 ; SDCONTEXT("USER DUZ") = The DUZ of the user taking action in the calling application.
+6 ; SDCONTEXT("USER SECID") = The SECID of the user taking action in the calling application.
+7 ;
+8 ; SDPARAM("CLINIC IEN")=CLINIC IEN IEN of the clinic in file 44 - Hospital location
+9 ; SDPARAM("INACTIVATION DATE")=DATE ISO DATE to inactivate the clinic if empty default to today (DT)
+10 ;
+11 ;RETURN PARMETER:
+12 ; Status
+13 ;
+14 NEW ERRORS,RESULTS,CLINICIEN,INACTDATE
+15 ; validate context array
+16 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+17 IF $DATA(ERRORS)
SET ERRORS("ClinicInactivate",1)=""
DO BUILDJSON^SDES2JSON(.SDRETURN,.ERRORS)
QUIT
+18 DO VALCLINIEN^SDES2VAL44(.ERRORS,$GET(SDPARAM("CLINIC IEN")),1)
+19 IF $DATA(ERRORS)
SET ERRORS("ClinicInactivate",1)=""
DO BUILDJSON^SDES2JSON(.SDRETURN,.ERRORS)
QUIT
+20 DO INIT(.SDPARAM,.CLINICIEN,.INACTDATE)
+21 DO VALIDATE(.ERRORS,INACTDATE,CLINICIEN)
+22 DO NOAPPOINTMENTS(CLINICIEN,INACTDATE,.ERRORS)
+23 IF $DATA(ERRORS)
DO BUILDJSON^SDES2JSON(.SDRETURN,.ERRORS)
QUIT
+24 ; File the inactivation on HOSPITAL LOCATION
+25 DO BLDCINREC(.RESULTS,CLINICIEN,INACTDATE,.ERRORS)
+26 ; If the Clinic was inactivated then update the SDEC RESOURCE (409.831) with the inactivation information
+27 IF '$DATA(ERRORS)
DO UPDATECLNRES(CLINICIEN,INACTDATE,$GET(SDCONTEXT("USER DUZ")),.ERRORS)
+28 ; There was a problem updating 409.831 with the inactivation
IF $DATA(ERRORS)
DO BUILDJSON^SDES2JSON(.SDRETURN,.ERRORS)
QUIT
+29 DO ENCODE^SDES2JSON(.RESULTS,.SDRETURN)
+30 QUIT
+31 ;
INIT(SDPARAM,CLINICIEN,INACTDATE) ; initialize values needed
+1 SET CLINICIEN=$GET(SDPARAM("CLINIC IEN"))
+2 SET INACTDATE=$GET(SDPARAM("INACTIVATION DATE"))
+3 ; If no Inactivation Date then default it to today
+4 IF INACTDATE=""
SET INACTDATE=$$FMTISO^SDAMUTDT(DT)
+5 QUIT
+6 ;
VALIDATE(ERRORS,INACTIVEDATE,CLINICIEN) ; validate incoming parameters
+1 NEW FMDATE
+2 ; Validate the inactivation date
+3 SET FMDATE=$$ISOTFM^SDAMUTDT(INACTIVEDATE)
+4 IF FMDATE=-1
DO ERRLOG^SDES2JSON(.ERRORS,46,"For Clinic Inactivation")
+5 IF FMDATE>0
IF (FMDATE<DT)
DO ERRLOG^SDES2JSON(.ERRORS,46,"Clinic Inactivation can't be before today")
+6 IF (FMDATE>$$FMADD^XLFDT(DT,182))
DO ERRLOG^SDES2JSON(.ERRORS,46,"Inactivation Date greater than 6 Months in the future")
+7 QUIT
+8 ; Make sure there are no active appointments after the inactivation date
NOAPPOINTMENTS(CLINICIEN,INACTDATE,ERRORS) ;
+1 NEW POP,FMDATE,DATEIDX,LASTDATE,I1
+2 SET FMDATE=$$ISOTFM^SDAMUTDT($GET(INACTDATE))
+3 SET CLINICIEN=$GET(CLINICIEN)
+4 SET POP=0
SET LASTDATE=9999999
SET DATEIDX=FMDATE-.0001
+5 FOR
SET DATEIDX=$ORDER(^SC(CLINICIEN,"S",DATEIDX))
if 'DATEIDX!(POP)!(FMDATE'<LASTDATE&(LASTDATE))
QUIT
Begin DoDot:1
+6 SET I1=0
FOR
SET I1=$ORDER(^SC(CLINICIEN,"S",DATEIDX,1,I1))
if 'I1
QUIT
IF $$GET1^DIQ(44.003,I1_","_DATEIDX_","_CLINICIEN_",",310,"I")'="C"
SET POP=1
SET FMDATE=DATEIDX
QUIT
End DoDot:1
+7 IF POP
DO ERRLOG^SDES2JSON(.ERRORS,521)
+8 QUIT
+9 ;
BLDCINREC(SDCINREC,CLINICIEN,INACTIVEDATE,ERRORS) ;Inactivate Clinic
+1 ; If the inactivation was filed in FILEMAN, no errors recorded, otherwise populate ERRORS
+2 NEW SDERR,SDFDA,SDCLNNAME,FMDATE
+3 SET SDCLNNAME=""
+4 SET FMDATE=$$ISOTFM^SDAMUTDT(INACTIVEDATE)
+5 SET SDCLNNAME=$$GET1^DIQ(44,CLINICIEN,.01)
+6 SET SDFDA(44,CLINICIEN_",",2505)=FMDATE
+7 DO UPDATE^DIE("","SDFDA","","SDERR")
+8 IF $GET(SDERR)
DO ERRLOG^SDES2JSON(.ERRORS,81)
QUIT
+9 SET SDCINREC("ClinicInactivate",1)="Clinic is successfully inactivated."
+10 QUIT
+11 ;
UPDATECLNRES(SDCLINICIEN,INACTIVATIONDATE,SDDUZ,ERRORS) ;Update INACTIVATED DATE/TIME and INACTIVATED BY USER in SDEC RESOURCE File #409.831
+1 NEW SDRESFDA,SDCLINRES,SDERR,FMDATE
+2 SET SDCLINRES=$$GETRES^SDES2UTIL1(SDCLINICIEN,1)
+3 ; no resource associated with clinic
if SDCLINRES=""
QUIT
+4 SET FMDATE=$$ISOTFM^SDAMUTDT(INACTIVATIONDATE)
+5 SET SDRESFDA(409.831,SDCLINRES_",",.021)=$PIECE(FMDATE,".")
+6 SET SDRESFDA(409.831,SDCLINRES_",",.022)=$SELECT(SDDUZ'="":SDDUZ,1:DUZ)
+7 DO FILE^DIE("","SDRESFDA","SDERR")
+8 IF $DATA(SDERR)
DO ERRLOG^SDES2JSON(.ERRORS,81,"File 409.831 not updated with the inactivation date for Resource IEN="_SDCLINRES)
+9 QUIT
