SDES2SNODEUTIL ;ALB/JAS - UTILITIES TO FIND AND FIX MISSING S NODES ; April 20, 2026
;;5.3;SCHEDULING;**943**;AUG 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;;
Q
;
;
ALLPATS(INCLUDECAN) ; MAIN ENTRY POINT TO SEARCH ALL PATIENTS
N INDEX,RETURN,STARTDATE,SDPATIENT,SDSTART
S STARTDATE=$$FMADD^XLFDT(DT,-91)_".999999"
D MES^XPDUTL("")
D MES^XPDUTL(" CLINIC FILE 'S' NODE MISMATCH REPORT")
D MES^XPDUTL("")
D MES^XPDUTL("PATIENT DFN^APPT IEN^CLINIC IEN^APPT START DATE/TIME^APPT CREATE DATE^ISSUE")
D MES^XPDUTL("")
S SDPATIENT=0
F S SDPATIENT=$O(^SDEC(409.84,"APTDT",SDPATIENT)) Q:'SDPATIENT D
. S SDSTART=STARTDATE
. I $G(INCLUDECAN) D ALLONEPAT(.RETURN,SDPATIENT,SDSTART)
. I '$G(INCLUDECAN) D ONEPAT(.RETURN,SDPATIENT,SDSTART)
. I $D(RETURN) D
. . S INDEX=0 F S INDEX=$O(RETURN(INDEX)) Q:'INDEX D
. . . D MES^XPDUTL(RETURN(INDEX))
. . K RETURN
Q
;
ALLONEPAT(RETURN,SDPATIENT,SDSTART) ; Full S Node Search for a single patient
N APPTCNT,APPTIEN,CLINICIEN,DATEMADE,FOUND,INDEX,RESOURCE,SNODE,SNODECNT,SNODEIEN
S INDEX=0
F S SDSTART=$O(^SDEC(409.84,"APTDT",SDPATIENT,SDSTART)) Q:'SDSTART D
. S (APPTCNT,APPTIEN,SNODECNT)=0
. F S APPTIEN=$O(^SDEC(409.84,"APTDT",SDPATIENT,SDSTART,APPTIEN)) Q:'APPTIEN D
. . S RESOURCE=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
. . S CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
. . S DATEMADE=$$GET1^DIQ(409.84,APPTIEN,.09,"I")
. . I '$D(^SC(CLINICIEN,"S",SDSTART)) D Q
. . . S INDEX=INDEX+1
. . . S RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^MISSING PARENT IN 44.003"
. . I '$O(^SC(CLINICIEN,"S",SDSTART,1,0)) D Q
. . . S INDEX=INDEX+1
. . . S RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^NO RECORDS UNDER 44.003 PARENT"
. . S APPTCNT=APPTCNT+1,(FOUND,SNODECNT,SNODEIEN)=0
. . F S SNODEIEN=$O(^SC(CLINICIEN,"S",SDSTART,1,SNODEIEN)) Q:'SNODEIEN D
. . . S SNODE=$G(^SC(CLINICIEN,"S",SDSTART,1,SNODEIEN,0)) Q:'+SNODE
. . . I +SNODE=SDPATIENT S SNODECNT=SNODECNT+1
. . . I DATEMADE=$P(SNODE,"^",7) S FOUND=1
. . I 'FOUND D Q
. . . S INDEX=INDEX+1
. . . S RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^MATCHING 'S' NODE NOT FOUND"
. . I APPTCNT'=SNODECNT D Q
. . . S INDEX=INDEX+1
. . . S RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^MISMATCHING PATIENT 'S' NODES FOR APPT DATE/TIME"
Q
;
ONEPAT(RETURN,SDPATIENT,SDSTART) ; Non-canceled S Node Search for a single patient
N APPTCNT,APPTIEN,CANCELED,CLINICIEN,DATEMADE,FOUND,INDEX,RESOURCE,SNODE,SNODECNT,SNODEIEN
S INDEX=0
F S SDSTART=$O(^SDEC(409.84,"APTDT",SDPATIENT,SDSTART)) Q:'SDSTART D
. S (APPTCNT,APPTIEN,SNODECNT)=0
. S APPTIEN=$O(^SDEC(409.84,"APTDT",SDPATIENT,SDSTART,APPTIEN)) Q:'APPTIEN D
. . S CANCELED=$$GET1^DIQ(409.84,APPTIEN,.12,"I")
. . Q:$G(CANCELED)
. . S RESOURCE=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
. . S CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
. . S DATEMADE=$$GET1^DIQ(409.84,APPTIEN,.09,"I")
. . I '$D(^SC(CLINICIEN,"S",SDSTART)) D Q
. . . S INDEX=INDEX+1
. . . S RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^MISSING PARENT IN 44.003"
. . I '$O(^SC(CLINICIEN,"S",SDSTART,1,0)) D Q
. . . S INDEX=INDEX+1
. . . S RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^NO RECORDS UNDER 44.003 PARENT"
. . S (FOUND,SNODECNT,SNODEIEN)=0
. . F S SNODEIEN=$O(^SC(CLINICIEN,"S",SDSTART,1,SNODEIEN)) Q:'SNODEIEN!(FOUND) D
. . . S SNODE=$G(^SC(CLINICIEN,"S",SDSTART,1,SNODEIEN,0)) Q:'+SNODE
. . . Q:+SNODE'=SDPATIENT
. . . Q:$P(SNODE,"^",9)="C"
. . . Q:DATEMADE'=$P(SNODE,"^",7)
. . . S FOUND=1
. . I 'FOUND D Q
. . . S INDEX=INDEX+1
. . . S RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^MATCHING 'S' NODE NOT FOUND"
Q
;
FIXONE(APPTIEN) ;
;
N ADJUSTAVAIL,APPTDATA,CLINICIEN,ENDTIME,ERR,FDA,FDAERR,RESOURCE,STARTTIME,MSG,NEWIEN44001
S ERR=0
;
I '$D(^SDEC(409.84,APPTIEN)) D Q
. S MSG=APPTIEN_" is an invalid Appointment IEN."
. D WRTMSG(MSG)
;
I $$CHECKONE(APPTIEN) D Q
. S MSG="Appointment IEN "_APPTIEN_" already has a valid 'S' node."
. D WRTMSG(MSG)
;
D GETS^DIQ(409.84,APPTIEN,".01;.02;.03;.04;.05;.07;.08;.09;.12;.14;.18","I","APPTDATA","SDERRORS")
S RESOURCE=APPTDATA(409.84,APPTIEN_",",.07,"I")
S CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
S STARTTIME=APPTDATA(409.84,APPTIEN_",",.01,"I")
S ENDTIME=APPTDATA(409.84,APPTIEN_",",.02,"I")
;
I '$D(^SC(CLINICIEN,"S",STARTTIME)) D Q:ERR
. S NEWIEN44001(1)=STARTTIME
. S FDA(44.001,"+1,"_CLINICIEN_",",.01)=STARTTIME
. D UPDATE^DIE(,"FDA","NEWIEN44001","FDAERR")
. I $D(FDAERR) D
. . S ERR=1,MSG="There was an issue creating the Parent 'S' Node"
. . D WRTMSG(MSG)
. K FDA,FDAERR
;
N IENS,INDEX,NEWIEN44003,NOTE
S IENS=STARTTIME_","_CLINICIEN_",",INDEX=0,NOTE=""
S FDA(44.003,"+1,"_IENS,.01)=APPTDATA(409.84,APPTIEN_",",.05,"I") ; Patient DFN
S FDA(44.003,"+1,"_IENS,1)=APPTDATA(409.84,APPTIEN_",",.18,"I") ; Appt Length
I $L($G(APPTDATA(409.84,APPTIEN_",",1,1))) D
. F S INDEX=$O(APPTDATA(409.84,APPTIEN_",",1,INDEX)) Q:'INDEX D
. . I '$L(NOTE) S NOTE=APPTDATA(409.84,APPTIEN_",",1,INDEX) Q
. . S NOTE=" "_APPTDATA(409.84,APPTIEN_",",1,INDEX)
. S FDA(44.003,"+1,"_IENS,3)=NOTE ; Appt Reason
S FDA(44.003,"+1,"_IENS,7)=APPTDATA(409.84,APPTIEN_",",.08,"I") ; Data Entry Clerk
S FDA(44.003,"+1,"_IENS,8)=APPTDATA(409.84,APPTIEN_",",.09,"I") ; Date Appt Made
S FDA(44.003,"+1,"_IENS,30)=$P($G(^DPT(APPTDATA(409.84,APPTIEN_",",.05,"I"),.36)),"^",1) ; Eligibility
;
I $G(APPTDATA(409.84,APPTIEN_",",.12,"I")) S FDA(44.003,"+1,"_IENS,310)="C" ; Appt Canceled?
S FDA(44.003,"+1,"_IENS,9)="" ; Overbook node
D UPDATE^DIE(,"FDA","NEWIEN44003","FDAERR")
I $D(FDAERR) D Q
. S MSG="There was an issue creating the missing 'S' Node for Appt IEN: "_APPTIEN_"."
;
I $G(APPTDATA(409.84,APPTIEN_",",.03,"I")) D
. S $P(^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"C"),"^")=APPTDATA(409.84,APPTIEN_",",.03,"I") ; Checked-in
. S $P(^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"C"),"^",2)=APPTDATA(409.84,APPTIEN_",",.08,"I") ; Check In User
. S $P(^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"C"),"^",5)=APPTDATA(409.84,APPTIEN_",",.04,"I") ; Check In Entered
I $G(APPTDATA(409.84,APPTIEN_",",.14,"I")) D
. S $P(^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"C"),"^",3)=APPTDATA(409.84,APPTIEN_",",.14,"I") ; Checked Out
. S $P(^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"C"),"^",4)=APPTDATA(409.84,APPTIEN_",",.08,"I") ; Check Out User
. S $P(^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"C"),"^",6)=APPTDATA(409.84,APPTIEN_",",.14,"I") ; Check Out Entered
;
S MSG="The missing 'S' node for Appt IEN "_APPTIEN_" has been created."
D WRTMSG(MSG)
;
I $P(STARTTIME,".")<DT D Q
. S MSG="Appointment IEN "_APPTIEN_" is in the past, please check and adjust availability, if needed."
. D WRTMSG(MSG)
;
; does current avail match actual avail?
N ERRORS
S ADJUSTAVAIL=$$COMPAREAVAIL(CLINICIEN,STARTTIME,ENDTIME,.ERRORS)
I $G(ERRORS) D Q
. S MSG="There was an issue calculating availability - please check manually."
. D WRTMSG(MSG)
;
I ADJUSTAVAIL=0 D Q
. S MSG="The current availability for "_$$FMTISO^SDAMUTDT(STARTTIME)_" appears to be correct."
. D WRTMSG(MSG)
;
I ADJUSTAVAIL>0 D
. D INCREMENTAVAIL1^SDESUTIL(CLINICIEN,STARTTIME,APPTDATA(409.84,APPTIEN_",",.18,"I"))
;
I ADJUSTAVAIL<0 D
. D AVUPDT^SDEC07C(CLINICIEN,STARTTIME,APPTDATA(409.84,APPTIEN_",",.18,"I"))
;
S MSG="Clinic availability has been adjusted for "_$$FMTISO^SDAMUTDT(STARTTIME)_"."
D WRTMSG(MSG)
;
I ADJUSTAVAIL=-2 D Q
. S ^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"OB")="O"
. S MSG="Appointment IEN "_APPTIEN_" has been marked as an overbook."
. D WRTMSG(MSG)
;
Q
;
WRTMSG(MSG) ;
;
D MES^XPDUTL("")
D MES^XPDUTL(MSG)
D MES^XPDUTL("")
Q
;
CHECKONE(APPTIEN) ;
N CANCELED,CLINICIEN,DATEMADE,FOUND,RESOURCE,SDPATIENT,SDSTART,SNODE,SNODEIEN
;
S SDSTART=$$GET1^DIQ(409.84,APPTIEN,.01,"I")
S SDPATIENT=$$GET1^DIQ(409.84,APPTIEN,.05,"I")
S RESOURCE=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
S CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
S DATEMADE=$$GET1^DIQ(409.84,APPTIEN,.09,"I")
S CANCELED=$$GET1^DIQ(409.84,APPTIEN,.12,"I")
;
; no 44.003 parent
I '$D(^SC(CLINICIEN,"S",SDSTART)) Q 0
; no children under 44.003 parent
I '$O(^SC(CLINICIEN,"S",SDSTART,1,0)) Q 0
;
S (FOUND,SNODEIEN)=0
F S SNODEIEN=$O(^SC(CLINICIEN,"S",SDSTART,1,SNODEIEN)) Q:'SNODEIEN D
. S SNODE=$G(^SC(CLINICIEN,"S",SDSTART,1,SNODEIEN,0)) Q:'+SNODE
. ; wrong patient
. Q:+SNODE'=SDPATIENT
. ; wrong create date
. Q:DATEMADE'=$P(SNODE,"^",7)
. ; mismatches
. Q:$G(CANCELED)&($P(SNODE,"^",9)'="")
. Q:'$G(CANCELED)&($P(SNODE,"^",9)="C")
. S FOUND=1
I 'FOUND Q 0
Q 1
;
COMPAREAVAIL(CLINICIEN,STARTTIME,ENDTIME,ERRORS) ;
;
N APPTCNT,COMPTIME,CURRAVAIL,INDEX,JSONRET,ORIGAVAIL,RETURN
S (CURRAVAIL,ORIGAVAIL)=0
;
; get original availability
D GETSCHEDULE^SDESCLINDAILYSCH(.RETURN,CLINICIEN,$$FMTISO^SDAMUTDT($P(STARTTIME,".")))
D DECODE^XLFJSON("RETURN","JSONRET")
I $D(JSONRET("Error")) S ERRORS=1 Q ""
;
S COMPTIME="*"_$P(STARTTIME,".",2),COMPTIME=$E(COMPTIME_$TR($J("",5)," ","0"),2,5)
S INDEX=0
F S INDEX=$O(JSONRET("ClinicSlot",INDEX)) Q:'INDEX D
. I $G(JSONRET("ClinicSlot",INDEX,"StartTime"))=COMPTIME D
. . S ORIGAVAIL=JSONRET("ClinicSlot",INDEX,"OpenSlots")
;
; get current availability
K JSONRET,RETURN
D GETCLAVAILABLTY^SDESCLINICAVAIL(.RETURN,CLINICIEN,$$FMTISO^SDAMUTDT(STARTTIME),$$FMTISO^SDAMUTDT(ENDTIME))
D DECODE^XLFJSON("RETURN","JSONRET")
I $D(JSONRET("Error")) S ERRORS=1 Q ""
;
S INDEX=0
F S INDEX=$O(JSONRET("ClinAvail",INDEX)) Q:'INDEX D
. I $G(JSONRET("ClinAvail",INDEX,"BeginTime"))=$$FMTISO^SDAMUTDT(STARTTIME) D
. . S CURRAVAIL=JSONRET("ClinAvail",INDEX,"SlotsAvail")
;
; get actual avail by looping through the clinic's "S" node
S (APPTCNT,INDEX)=0
F S INDEX=$O(^SC(CLINICIEN,"S",STARTTIME,1,INDEX)) Q:'INDEX D
. Q:'$D(^SC(CLINICIEN,"S",STARTTIME,1,INDEX,0))
. Q:$P(^SC(CLINICIEN,"S",STARTTIME,1,INDEX,0),"^",9)="C"
. Q:$G(^SC(CLINICIEN,"S",STARTTIME,1,INDEX,"OB"))="O"
. S APPTCNT=APPTCNT+1
;
; determine if adjustment is needed
I (ORIGAVAIL-APPTCNT)=CURRAVAIL Q 0
I ((ORIGAVAIL-APPTCNT)<CURRAVAIL)&(CURRAVAIL=0) Q -2 ;overbook
I (ORIGAVAIL-APPTCNT)<CURRAVAIL Q -1 ;decrement avail
I (ORIGAVAIL-APPTCNT)>CURRAVAIL Q 1 ;increment avail
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2SNODEUTIL 10719 printed Jul 11, 2026@02:51:50 Page 2
SDES2SNODEUTIL ;ALB/JAS - UTILITIES TO FIND AND FIX MISSING S NODES ; April 20, 2026
+1 ;;5.3;SCHEDULING;**943**;AUG 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;;
+4 QUIT
+5 ;
+6 ;
ALLPATS(INCLUDECAN) ; MAIN ENTRY POINT TO SEARCH ALL PATIENTS
+1 NEW INDEX,RETURN,STARTDATE,SDPATIENT,SDSTART
+2 SET STARTDATE=$$FMADD^XLFDT(DT,-91)_".999999"
+3 DO MES^XPDUTL("")
+4 DO MES^XPDUTL(" CLINIC FILE 'S' NODE MISMATCH REPORT")
+5 DO MES^XPDUTL("")
+6 DO MES^XPDUTL("PATIENT DFN^APPT IEN^CLINIC IEN^APPT START DATE/TIME^APPT CREATE DATE^ISSUE")
+7 DO MES^XPDUTL("")
+8 SET SDPATIENT=0
+9 FOR
SET SDPATIENT=$ORDER(^SDEC(409.84,"APTDT",SDPATIENT))
if 'SDPATIENT
QUIT
Begin DoDot:1
+10 SET SDSTART=STARTDATE
+11 IF $GET(INCLUDECAN)
DO ALLONEPAT(.RETURN,SDPATIENT,SDSTART)
+12 IF '$GET(INCLUDECAN)
DO ONEPAT(.RETURN,SDPATIENT,SDSTART)
+13 IF $DATA(RETURN)
Begin DoDot:2
+14 SET INDEX=0
FOR
SET INDEX=$ORDER(RETURN(INDEX))
if 'INDEX
QUIT
Begin DoDot:3
+15 DO MES^XPDUTL(RETURN(INDEX))
End DoDot:3
+16 KILL RETURN
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
ALLONEPAT(RETURN,SDPATIENT,SDSTART) ; Full S Node Search for a single patient
+1 NEW APPTCNT,APPTIEN,CLINICIEN,DATEMADE,FOUND,INDEX,RESOURCE,SNODE,SNODECNT,SNODEIEN
+2 SET INDEX=0
+3 FOR
SET SDSTART=$ORDER(^SDEC(409.84,"APTDT",SDPATIENT,SDSTART))
if 'SDSTART
QUIT
Begin DoDot:1
+4 SET (APPTCNT,APPTIEN,SNODECNT)=0
+5 FOR
SET APPTIEN=$ORDER(^SDEC(409.84,"APTDT",SDPATIENT,SDSTART,APPTIEN))
if 'APPTIEN
QUIT
Begin DoDot:2
+6 SET RESOURCE=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
+7 SET CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
+8 SET DATEMADE=$$GET1^DIQ(409.84,APPTIEN,.09,"I")
+9 IF '$DATA(^SC(CLINICIEN,"S",SDSTART))
Begin DoDot:3
+10 SET INDEX=INDEX+1
+11 SET RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^MISSING PARENT IN 44.003"
End DoDot:3
QUIT
+12 IF '$ORDER(^SC(CLINICIEN,"S",SDSTART,1,0))
Begin DoDot:3
+13 SET INDEX=INDEX+1
+14 SET RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^NO RECORDS UNDER 44.003 PARENT"
End DoDot:3
QUIT
+15 SET APPTCNT=APPTCNT+1
SET (FOUND,SNODECNT,SNODEIEN)=0
+16 FOR
SET SNODEIEN=$ORDER(^SC(CLINICIEN,"S",SDSTART,1,SNODEIEN))
if 'SNODEIEN
QUIT
Begin DoDot:3
+17 SET SNODE=$GET(^SC(CLINICIEN,"S",SDSTART,1,SNODEIEN,0))
if '+SNODE
QUIT
+18 IF +SNODE=SDPATIENT
SET SNODECNT=SNODECNT+1
+19 IF DATEMADE=$PIECE(SNODE,"^",7)
SET FOUND=1
End DoDot:3
+20 IF 'FOUND
Begin DoDot:3
+21 SET INDEX=INDEX+1
+22 SET RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^MATCHING 'S' NODE NOT FOUND"
End DoDot:3
QUIT
+23 IF APPTCNT'=SNODECNT
Begin DoDot:3
+24 SET INDEX=INDEX+1
+25 SET RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^MISMATCHING PATIENT 'S' NODES FOR APPT DATE/TIME"
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
ONEPAT(RETURN,SDPATIENT,SDSTART) ; Non-canceled S Node Search for a single patient
+1 NEW APPTCNT,APPTIEN,CANCELED,CLINICIEN,DATEMADE,FOUND,INDEX,RESOURCE,SNODE,SNODECNT,SNODEIEN
+2 SET INDEX=0
+3 FOR
SET SDSTART=$ORDER(^SDEC(409.84,"APTDT",SDPATIENT,SDSTART))
if 'SDSTART
QUIT
Begin DoDot:1
+4 SET (APPTCNT,APPTIEN,SNODECNT)=0
+5 SET APPTIEN=$ORDER(^SDEC(409.84,"APTDT",SDPATIENT,SDSTART,APPTIEN))
if 'APPTIEN
QUIT
Begin DoDot:2
+6 SET CANCELED=$$GET1^DIQ(409.84,APPTIEN,.12,"I")
+7 if $GET(CANCELED)
QUIT
+8 SET RESOURCE=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
+9 SET CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
+10 SET DATEMADE=$$GET1^DIQ(409.84,APPTIEN,.09,"I")
+11 IF '$DATA(^SC(CLINICIEN,"S",SDSTART))
Begin DoDot:3
+12 SET INDEX=INDEX+1
+13 SET RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^MISSING PARENT IN 44.003"
End DoDot:3
QUIT
+14 IF '$ORDER(^SC(CLINICIEN,"S",SDSTART,1,0))
Begin DoDot:3
+15 SET INDEX=INDEX+1
+16 SET RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^NO RECORDS UNDER 44.003 PARENT"
End DoDot:3
QUIT
+17 SET (FOUND,SNODECNT,SNODEIEN)=0
+18 FOR
SET SNODEIEN=$ORDER(^SC(CLINICIEN,"S",SDSTART,1,SNODEIEN))
if 'SNODEIEN!(FOUND)
QUIT
Begin DoDot:3
+19 SET SNODE=$GET(^SC(CLINICIEN,"S",SDSTART,1,SNODEIEN,0))
if '+SNODE
QUIT
+20 if +SNODE'=SDPATIENT
QUIT
+21 if $PIECE(SNODE,"^",9)="C"
QUIT
+22 if DATEMADE'=$PIECE(SNODE,"^",7)
QUIT
+23 SET FOUND=1
End DoDot:3
+24 IF 'FOUND
Begin DoDot:3
+25 SET INDEX=INDEX+1
+26 SET RETURN(INDEX)=SDPATIENT_"^"_APPTIEN_"^"_CLINICIEN_"^"_SDSTART_"^"_DATEMADE_"^MATCHING 'S' NODE NOT FOUND"
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+27 QUIT
+28 ;
FIXONE(APPTIEN) ;
+1 ;
+2 NEW ADJUSTAVAIL,APPTDATA,CLINICIEN,ENDTIME,ERR,FDA,FDAERR,RESOURCE,STARTTIME,MSG,NEWIEN44001
+3 SET ERR=0
+4 ;
+5 IF '$DATA(^SDEC(409.84,APPTIEN))
Begin DoDot:1
+6 SET MSG=APPTIEN_" is an invalid Appointment IEN."
+7 DO WRTMSG(MSG)
End DoDot:1
QUIT
+8 ;
+9 IF $$CHECKONE(APPTIEN)
Begin DoDot:1
+10 SET MSG="Appointment IEN "_APPTIEN_" already has a valid 'S' node."
+11 DO WRTMSG(MSG)
End DoDot:1
QUIT
+12 ;
+13 DO GETS^DIQ(409.84,APPTIEN,".01;.02;.03;.04;.05;.07;.08;.09;.12;.14;.18","I","APPTDATA","SDERRORS")
+14 SET RESOURCE=APPTDATA(409.84,APPTIEN_",",.07,"I")
+15 SET CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
+16 SET STARTTIME=APPTDATA(409.84,APPTIEN_",",.01,"I")
+17 SET ENDTIME=APPTDATA(409.84,APPTIEN_",",.02,"I")
+18 ;
+19 IF '$DATA(^SC(CLINICIEN,"S",STARTTIME))
Begin DoDot:1
+20 SET NEWIEN44001(1)=STARTTIME
+21 SET FDA(44.001,"+1,"_CLINICIEN_",",.01)=STARTTIME
+22 DO UPDATE^DIE(,"FDA","NEWIEN44001","FDAERR")
+23 IF $DATA(FDAERR)
Begin DoDot:2
+24 SET ERR=1
SET MSG="There was an issue creating the Parent 'S' Node"
+25 DO WRTMSG(MSG)
End DoDot:2
+26 KILL FDA,FDAERR
End DoDot:1
if ERR
QUIT
+27 ;
+28 NEW IENS,INDEX,NEWIEN44003,NOTE
+29 SET IENS=STARTTIME_","_CLINICIEN_","
SET INDEX=0
SET NOTE=""
+30 ; Patient DFN
SET FDA(44.003,"+1,"_IENS,.01)=APPTDATA(409.84,APPTIEN_",",.05,"I")
+31 ; Appt Length
SET FDA(44.003,"+1,"_IENS,1)=APPTDATA(409.84,APPTIEN_",",.18,"I")
+32 IF $LENGTH($GET(APPTDATA(409.84,APPTIEN_",",1,1)))
Begin DoDot:1
+33 FOR
SET INDEX=$ORDER(APPTDATA(409.84,APPTIEN_",",1,INDEX))
if 'INDEX
QUIT
Begin DoDot:2
+34 IF '$LENGTH(NOTE)
SET NOTE=APPTDATA(409.84,APPTIEN_",",1,INDEX)
QUIT
+35 SET NOTE=" "_APPTDATA(409.84,APPTIEN_",",1,INDEX)
End DoDot:2
+36 ; Appt Reason
SET FDA(44.003,"+1,"_IENS,3)=NOTE
End DoDot:1
+37 ; Data Entry Clerk
SET FDA(44.003,"+1,"_IENS,7)=APPTDATA(409.84,APPTIEN_",",.08,"I")
+38 ; Date Appt Made
SET FDA(44.003,"+1,"_IENS,8)=APPTDATA(409.84,APPTIEN_",",.09,"I")
+39 ; Eligibility
SET FDA(44.003,"+1,"_IENS,30)=$PIECE($GET(^DPT(APPTDATA(409.84,APPTIEN_",",.05,"I"),.36)),"^",1)
+40 ;
+41 ; Appt Canceled?
IF $GET(APPTDATA(409.84,APPTIEN_",",.12,"I"))
SET FDA(44.003,"+1,"_IENS,310)="C"
+42 ; Overbook node
SET FDA(44.003,"+1,"_IENS,9)=""
+43 DO UPDATE^DIE(,"FDA","NEWIEN44003","FDAERR")
+44 IF $DATA(FDAERR)
Begin DoDot:1
+45 SET MSG="There was an issue creating the missing 'S' Node for Appt IEN: "_APPTIEN_"."
End DoDot:1
QUIT
+46 ;
+47 IF $GET(APPTDATA(409.84,APPTIEN_",",.03,"I"))
Begin DoDot:1
+48 ; Checked-in
SET $PIECE(^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"C"),"^")=APPTDATA(409.84,APPTIEN_",",.03,"I")
+49 ; Check In User
SET $PIECE(^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"C"),"^",2)=APPTDATA(409.84,APPTIEN_",",.08,"I")
+50 ; Check In Entered
SET $PIECE(^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"C"),"^",5)=APPTDATA(409.84,APPTIEN_",",.04,"I")
End DoDot:1
+51 IF $GET(APPTDATA(409.84,APPTIEN_",",.14,"I"))
Begin DoDot:1
+52 ; Checked Out
SET $PIECE(^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"C"),"^",3)=APPTDATA(409.84,APPTIEN_",",.14,"I")
+53 ; Check Out User
SET $PIECE(^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"C"),"^",4)=APPTDATA(409.84,APPTIEN_",",.08,"I")
+54 ; Check Out Entered
SET $PIECE(^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"C"),"^",6)=APPTDATA(409.84,APPTIEN_",",.14,"I")
End DoDot:1
+55 ;
+56 SET MSG="The missing 'S' node for Appt IEN "_APPTIEN_" has been created."
+57 DO WRTMSG(MSG)
+58 ;
+59 IF $PIECE(STARTTIME,".")<DT
Begin DoDot:1
+60 SET MSG="Appointment IEN "_APPTIEN_" is in the past, please check and adjust availability, if needed."
+61 DO WRTMSG(MSG)
End DoDot:1
QUIT
+62 ;
+63 ; does current avail match actual avail?
+64 NEW ERRORS
+65 SET ADJUSTAVAIL=$$COMPAREAVAIL(CLINICIEN,STARTTIME,ENDTIME,.ERRORS)
+66 IF $GET(ERRORS)
Begin DoDot:1
+67 SET MSG="There was an issue calculating availability - please check manually."
+68 DO WRTMSG(MSG)
End DoDot:1
QUIT
+69 ;
+70 IF ADJUSTAVAIL=0
Begin DoDot:1
+71 SET MSG="The current availability for "_$$FMTISO^SDAMUTDT(STARTTIME)_" appears to be correct."
+72 DO WRTMSG(MSG)
End DoDot:1
QUIT
+73 ;
+74 IF ADJUSTAVAIL>0
Begin DoDot:1
+75 DO INCREMENTAVAIL1^SDESUTIL(CLINICIEN,STARTTIME,APPTDATA(409.84,APPTIEN_",",.18,"I"))
End DoDot:1
+76 ;
+77 IF ADJUSTAVAIL<0
Begin DoDot:1
+78 DO AVUPDT^SDEC07C(CLINICIEN,STARTTIME,APPTDATA(409.84,APPTIEN_",",.18,"I"))
End DoDot:1
+79 ;
+80 SET MSG="Clinic availability has been adjusted for "_$$FMTISO^SDAMUTDT(STARTTIME)_"."
+81 DO WRTMSG(MSG)
+82 ;
+83 IF ADJUSTAVAIL=-2
Begin DoDot:1
+84 SET ^SC(CLINICIEN,"S",STARTTIME,1,NEWIEN44003(1),"OB")="O"
+85 SET MSG="Appointment IEN "_APPTIEN_" has been marked as an overbook."
+86 DO WRTMSG(MSG)
End DoDot:1
QUIT
+87 ;
+88 QUIT
+89 ;
WRTMSG(MSG) ;
+1 ;
+2 DO MES^XPDUTL("")
+3 DO MES^XPDUTL(MSG)
+4 DO MES^XPDUTL("")
+5 QUIT
+6 ;
CHECKONE(APPTIEN) ;
+1 NEW CANCELED,CLINICIEN,DATEMADE,FOUND,RESOURCE,SDPATIENT,SDSTART,SNODE,SNODEIEN
+2 ;
+3 SET SDSTART=$$GET1^DIQ(409.84,APPTIEN,.01,"I")
+4 SET SDPATIENT=$$GET1^DIQ(409.84,APPTIEN,.05,"I")
+5 SET RESOURCE=$$GET1^DIQ(409.84,APPTIEN,.07,"I")
+6 SET CLINICIEN=$$GET1^DIQ(409.831,RESOURCE,.04,"I")
+7 SET DATEMADE=$$GET1^DIQ(409.84,APPTIEN,.09,"I")
+8 SET CANCELED=$$GET1^DIQ(409.84,APPTIEN,.12,"I")
+9 ;
+10 ; no 44.003 parent
+11 IF '$DATA(^SC(CLINICIEN,"S",SDSTART))
QUIT 0
+12 ; no children under 44.003 parent
+13 IF '$ORDER(^SC(CLINICIEN,"S",SDSTART,1,0))
QUIT 0
+14 ;
+15 SET (FOUND,SNODEIEN)=0
+16 FOR
SET SNODEIEN=$ORDER(^SC(CLINICIEN,"S",SDSTART,1,SNODEIEN))
if 'SNODEIEN
QUIT
Begin DoDot:1
+17 SET SNODE=$GET(^SC(CLINICIEN,"S",SDSTART,1,SNODEIEN,0))
if '+SNODE
QUIT
+18 ; wrong patient
+19 if +SNODE'=SDPATIENT
QUIT
+20 ; wrong create date
+21 if DATEMADE'=$PIECE(SNODE,"^",7)
QUIT
+22 ; mismatches
+23 if $GET(CANCELED)&($PIECE(SNODE,"^",9)'="")
QUIT
+24 if '$GET(CANCELED)&($PIECE(SNODE,"^",9)="C")
QUIT
+25 SET FOUND=1
End DoDot:1
+26 IF 'FOUND
QUIT 0
+27 QUIT 1
+28 ;
COMPAREAVAIL(CLINICIEN,STARTTIME,ENDTIME,ERRORS) ;
+1 ;
+2 NEW APPTCNT,COMPTIME,CURRAVAIL,INDEX,JSONRET,ORIGAVAIL,RETURN
+3 SET (CURRAVAIL,ORIGAVAIL)=0
+4 ;
+5 ; get original availability
+6 DO GETSCHEDULE^SDESCLINDAILYSCH(.RETURN,CLINICIEN,$$FMTISO^SDAMUTDT($PIECE(STARTTIME,".")))
+7 DO DECODE^XLFJSON("RETURN","JSONRET")
+8 IF $DATA(JSONRET("Error"))
SET ERRORS=1
QUIT ""
+9 ;
+10 SET COMPTIME="*"_$PIECE(STARTTIME,".",2)
SET COMPTIME=$EXTRACT(COMPTIME_$TRANSLATE($JUSTIFY("",5)," ","0"),2,5)
+11 SET INDEX=0
+12 FOR
SET INDEX=$ORDER(JSONRET("ClinicSlot",INDEX))
if 'INDEX
QUIT
Begin DoDot:1
+13 IF $GET(JSONRET("ClinicSlot",INDEX,"StartTime"))=COMPTIME
Begin DoDot:2
+14 SET ORIGAVAIL=JSONRET("ClinicSlot",INDEX,"OpenSlots")
End DoDot:2
End DoDot:1
+15 ;
+16 ; get current availability
+17 KILL JSONRET,RETURN
+18 DO GETCLAVAILABLTY^SDESCLINICAVAIL(.RETURN,CLINICIEN,$$FMTISO^SDAMUTDT(STARTTIME),$$FMTISO^SDAMUTDT(ENDTIME))
+19 DO DECODE^XLFJSON("RETURN","JSONRET")
+20 IF $DATA(JSONRET("Error"))
SET ERRORS=1
QUIT ""
+21 ;
+22 SET INDEX=0
+23 FOR
SET INDEX=$ORDER(JSONRET("ClinAvail",INDEX))
if 'INDEX
QUIT
Begin DoDot:1
+24 IF $GET(JSONRET("ClinAvail",INDEX,"BeginTime"))=$$FMTISO^SDAMUTDT(STARTTIME)
Begin DoDot:2
+25 SET CURRAVAIL=JSONRET("ClinAvail",INDEX,"SlotsAvail")
End DoDot:2
End DoDot:1
+26 ;
+27 ; get actual avail by looping through the clinic's "S" node
+28 SET (APPTCNT,INDEX)=0
+29 FOR
SET INDEX=$ORDER(^SC(CLINICIEN,"S",STARTTIME,1,INDEX))
if 'INDEX
QUIT
Begin DoDot:1
+30 if '$DATA(^SC(CLINICIEN,"S",STARTTIME,1,INDEX,0))
QUIT
+31 if $PIECE(^SC(CLINICIEN,"S",STARTTIME,1,INDEX,0),"^",9)="C"
QUIT
+32 if $GET(^SC(CLINICIEN,"S",STARTTIME,1,INDEX,"OB"))="O"
QUIT
+33 SET APPTCNT=APPTCNT+1
End DoDot:1
+34 ;
+35 ; determine if adjustment is needed
+36 IF (ORIGAVAIL-APPTCNT)=CURRAVAIL
QUIT 0
+37 ;overbook
IF ((ORIGAVAIL-APPTCNT)<CURRAVAIL)&(CURRAVAIL=0)
QUIT -2
+38 ;decrement avail
IF (ORIGAVAIL-APPTCNT)<CURRAVAIL
QUIT -1
+39 ;increment avail
IF (ORIGAVAIL-APPTCNT)>CURRAVAIL
QUIT 1
+40 QUIT ""
