SDES2REMAPUTIL ;ALB/BWF/JAS - REMAP DIVISION/CLINIC ; MAY 21, 2025
;;5.3;Scheduling;**908**;Aug 13, 1993;Build 2
;;Per VHA Directive 6402, this routine should not be modified
;
Q
; validation
VALIDATE(ERRORS,SDINPUT,QUEUEREMAP) ;
N DIVISIONIEN,CLINICIEN,CLINCNT
I $D(SDINPUT("DIVISION","ALL")) S QUEUEREMAP=1 Q
S CLINCNT=0
I $D(SDINPUT("DIVISION")) D Q
.S DIVISIONIEN=0
.F S DIVISIONIEN=$O(SDINPUT("DIVISION",DIVISIONIEN)) Q:'DIVISIONIEN D
..I '$D(^DG(40.8,DIVISIONIEN,0)) D ERRLOG^SDES2JSON(.ERRORS,97)
..I $D(SDINPUT("DIVISION",DIVISIONIEN)),'$D(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC")) S QUEUEREMAP=1 Q
..; no need to validate clinics if 'ALL' clinics are indicated
..I $D(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC","ALL")) S QUEUEREMAP=1 Q
..; validate individual clinics
..I $D(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC")) D
...S CLINICIEN=0
...F S CLINICIEN=$O(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC",CLINICIEN)) Q:'CLINICIEN D
....I '$D(^SC(CLINICIEN,0)) D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid clinic: "_CLINICIEN)
....I $$GET1^DIQ(44,CLINICIEN,2,"I")'="C" D ERRLOG^SDES2JSON(.ERRORS,52,"IEN "_CLINICIEN_" is not 'Clinic'.")
....I $$GET1^DIQ(44,CLINICIEN,3.5,"I")'=DIVISIONIEN D ERRLOG^SDES2JSON(.ERRORS,52,"Clinic "_CLINICIEN_" is not associated with Division: "_DIVISIONIEN)
....I $$INACTIVE^SDES2UTIL(CLINICIEN,DT) D ERRLOG^SDES2JSON(.ERRORS,52,"Inactive Clinic: "_CLINICIEN)
....S CLINCNT=CLINCNT+1
.I CLINCNT>20 S QUEUEREMAP=1
;
I $D(SDINPUT("CLINIC")) D
.S CLINICIEN=0 F S CLINIEN=$O(SDINPUT("CLINIC",CLINICIEN)) Q:'CLINICIEN D
..I '$D(^SC(CLINICIEN,0)) D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid clinic: "_CLINICIEN)
..I $$GET1^DIQ(44,CLINIEN,2,"I")'="C" D ERRLOG^SDES2JSON(.ERRORS,52,"IEN "_CLINICIEN_" is not 'Clinic'.")
..I $$INACTIVE^SDES2UTIL(CLINICIEN,DT) D ERRLOG^SDES2JSON(.ERRORS,52,"Inactive Clinic: "_CLINICIEN)
..S CLINCNT=CLINCNT+1
.I CLINCNT>20 S QUEUEREMAP=1
Q
;
TASKREMAP(SDINPUT,STARTDATE,ENDDATE,TASKRES,SDUSER) ;
N ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
S ZTDESC=""
I $D(SDINPUT("DIVISION","ALL")) S ZTDESC="Clinic Remap - All Divisions / All clinics"
I '$L(ZTDESC),$D(SDINPUT("DIVISION")) S ZTDESC="Clinic Remap - Division List"
I '$L(ZTDESC),$D(SDINPUT("CLINIC")) S ZTDESC="Clinic Remap - Clinic List"
I '$L(ZTDESC) S ZTDESC="Clinic Remap Background Process"
S ZTDTH=$$FMADD^XLFDT(DT,1)
S ZTDTH=ZTDTH_.02,ZTIO="",ZTRTN="BACKGROUNDREMAP^SDES2REMAPUTIL",ZTSAVE("*")="" D ^%ZTLOAD
I $D(ZTSK) D Q
.S TASKRES("ClinicRemap","Status")="Task "_ZTSK_" has been queued."
I '$D(ZTSK) D
.S TASKRES("ClinicRemap","Status")="UNABLE TO QUEUE THIS JOB. Please contact the National Help Desk to report this issue."
Q
BACKGROUNDREMAP ;
N DIVISIONIEN,CLINICIEN,GBL,TMPCOUNT,DATETIME
S DATETIME=$$NOW^XLFDT
S GBL=$NA(^TMP("SDES2REMAP",$J)) K @GBL
S (DIVISIONIEN,TMPCOUNT)=0
; all divisions
; build report header
D HEADER(.GBL,.TMPCOUNT)
;
I $D(SDINPUT("DIVISION","ALL")) D Q
.S CLINIEN=0 F S CLINIEN=$O(^SC(CLINIEN)) Q:'CLINIEN D
..Q:$$GET1^DIQ(44,CLINIEN,2,"I")'="C"
..Q:$$INACTIVE^SDES2UTIL(CLINIEN,DT)
..D REMAPCLIN^SDES2REMAP(.GBL,CLINIEN,STARTDATE,ENDDATE,.TMPCOUNT)
.D MAIL(GBL,SDUSER)
.K @GBL
;
; process division list with clinics = all, or multiple individual clinics
I $O(SDINPUT("DIVISION",0)) D Q
.F S DIVISIONIEN=$O(SDINPUT("DIVISION",DIVISIONIEN)) Q:'DIVISIONIEN D
..; process all clinics
..I $D(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC","ALL"))!('$D(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC"))) D Q
...S CLINICIEN=0
...F S CLINICIEN=$O(^SC(CLINICIEN)) Q:'CLINICIEN D
....Q:'$$CLINDIVCHECK(DIVISIONIEN,CLINICIEN)
....D REMAPCLIN^SDES2REMAP(.GBL,CLINICIEN,STARTDATE,ENDDATE,.TMPCOUNT)
..; process clinics in the list
..S CLINICIEN=0
..F S CLINICIEN=$O(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC",CLINICIEN)) Q:'CLINICIEN D
...Q:'$$CLINDIVCHECK(DIVISIONIEN,CLINICIEN)
.D MAIL(GBL,SDUSER)
.K @GBL
;
; process remap by clinic list
I $D(SDINPUT("CLINIC")) D Q
.S CLINIEN=0 F S CLINIEN=$O(SDINPUT("CLINIC",CLINIEN)) Q:'CLINIEN D
..Q:$$GET1^DIQ(44,CLINIEN,2,"I")'="C"
..Q:$$INACTIVE^SDES2UTIL(CLINIEN,DT)
..D REMAPCLIN^SDES2REMAP(.GBL,CLINIEN,STARTDATE,ENDDATE,.TMPCOUNT)
.D MAIL(GBL,SDUSER)
.K @GBL
Q
MAIL(GBL,USERDUZ) ;
N XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,USEREMAIL
; Send MailMan message
S XMTEXT="^TMP(""SDES2REMAP"","_$J_","
S XMSUB="REMAP CLINIC - Queued Remap results "_$$FMTE^XLFDT(DT)_" by: "_$$GET1^DIQ(200,USERDUZ,.01,"E")
S XMY(USERDUZ)=""
S USEREMAIL=$$GET1^DIQ(200,USERDUZ,.151,"E")
I USEREMAIL]"" S XMY(USEREMAIL)=""
D ^XMD
Q
CLINDIVCHECK(DIVIEN,CLINIEN) ;
Q:$$GET1^DIQ(44,CLINICIEN,2,"I")'="C" 0
Q:$$INACTIVE^SDES2UTIL(CLINICIEN,DT) 0
I $$GET1^DIQ(44,CLINICIEN,3.5,"I")'=DIVISIONIEN Q 0
Q 1
;
ACTIVEAPPTS(CLINIEN,REMAPDATE,FIRSTAPPTDTTM) ;
N HASAPPTS,STARTDTTM,ENDDTTM,APPTDTTM,APPTIEN
S HASAPPTS=0
S FIRSTAPPTDTTM=$O(^SC(CLINIEN,"S",REMAPDATE))
I FIRSTAPPTDTTM>(REMAPDATE_.9) S FIRSTAPPTDTTM=REMAPDATE Q HASAPPTS
S APPTDTTM=REMAPDATE-.01
F S APPTDTTM=$O(^SC(CLINIEN,"S",APPTDTTM)) Q:'APPTDTTM!($P(APPTDTTM,".")>REMAPDATE) D
.S APPTIEN=0 F S APPTIEN=$O(^SC(CLINIEN,"S",APPTDTTM,1,APPTIEN)) Q:'APPTIEN D
..I $$GET1^DIQ(44.003,APPTIEN_","_APPTDTTM_","_CLINIEN_",",310,"I")="C" Q
..S HASAPPTS=1
Q HASAPPTS
;
S TMPCOUNT=TMPCOUNT+1
S @GBL@(TMPCOUNT)=$$FMTE^XLFDT(DT)_" Clinic Remap Report "
S TMPCOUNT=TMPCOUNT+1
S @GBL@(TMPCOUNT)=" "
S TMPCOUNT=TMPCOUNT+1
S @GBL@(TMPCOUNT)=$$PAD($E("Division",1,30),33)_$$PAD($E("Clinic Name",1,30),33)_$$PAD("Clinic Date",19)_"Remark"
S TMPCOUNT=TMPCOUNT+1
S @GBL@(TMPCOUNT)=$$PAD($E("=========",1,30),33)_$$PAD($E("===========",1,30),33)_$$PAD("============",19)_"======"
S TMPCOUNT=TMPCOUNT+1
S @GBL@(TMPCOUNT)=" "
Q
LOGDATA(GBL,CLINGBL,TMPCOUNT,CLINTMPCNT,CLINICNAME,DIVNAME,DATE,SCHEDONHOLIDAY,ACTIVEAPPTS,DAY,REMARK) ;
N MESSAGE
; file the passed in remark and quit
I $L($G(REMARK)) D Q
.S TMPCOUNT=TMPCOUNT+1
.S CLINTMPCNT=CLINTMPCNT+1
.S (@GBL@(TMPCOUNT),@CLINGBL@(CLINTMPCNT))=$$PAD($E(DIVNAME,1,30),33)_$$PAD($E(CLINICNAME,1,30),33)_$$PAD($E(DAY,1,3),4)_$$PAD($$FMTE^XLFDT(DATE),15)_REMARK
; all other messages
S MESSAGE=$S($D(^HOLIDAY(DATE,0))&ACTIVEAPPTS:"- Appts!",$D(^HOLIDAY(DATE,0))&'SCHEDONHOLIDAY:"- Inserted",1:"")
I MESSAGE]"" S MESSAGE=MESSAGE
Q:MESSAGE']""
;S @GBL@(TMPCOUNT)=" "_$E(CLINICNAME,1,30)_$$PAD(CLINICNAME,33)_$$PAD($$FMTE^XLFDT(DATE),18)_REMARK
S TMPCOUNT=TMPCOUNT+1
S CLINTMPCNT=CLINTMPCNT+1
S (@GBL@(TMPCOUNT),@CLINGBL@(CLINTMPCNT))=$$PAD($E(DIVNAME,1,30),33)_$$PAD($E(CLINICNAME,1,30),33)_$$PAD($E(DAY,1,3),4)_$$PAD($$FMTE^XLFDT(DATE),15)_MESSAGE
Q
PAD(STRING,LENGTH) ;
N NLENGTH,SPACE,I,RETSTRING,SPACES
S NLENGTH=$L(STRING)
S SPACES=LENGTH-NLENGTH
S RETSTRING=STRING
F I=1:1:SPACES S RETSTRING=$G(RETSTRING)_" "
Q RETSTRING
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2REMAPUTIL 6986 printed Sep 23, 2025@20:31:15 Page 2
SDES2REMAPUTIL ;ALB/BWF/JAS - REMAP DIVISION/CLINIC ; MAY 21, 2025
+1 ;;5.3;Scheduling;**908**;Aug 13, 1993;Build 2
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ; validation
VALIDATE(ERRORS,SDINPUT,QUEUEREMAP) ;
+1 NEW DIVISIONIEN,CLINICIEN,CLINCNT
+2 IF $DATA(SDINPUT("DIVISION","ALL"))
SET QUEUEREMAP=1
QUIT
+3 SET CLINCNT=0
+4 IF $DATA(SDINPUT("DIVISION"))
Begin DoDot:1
+5 SET DIVISIONIEN=0
+6 FOR
SET DIVISIONIEN=$ORDER(SDINPUT("DIVISION",DIVISIONIEN))
if 'DIVISIONIEN
QUIT
Begin DoDot:2
+7 IF '$DATA(^DG(40.8,DIVISIONIEN,0))
DO ERRLOG^SDES2JSON(.ERRORS,97)
+8 IF $DATA(SDINPUT("DIVISION",DIVISIONIEN))
IF '$DATA(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC"))
SET QUEUEREMAP=1
QUIT
+9 ; no need to validate clinics if 'ALL' clinics are indicated
+10 IF $DATA(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC","ALL"))
SET QUEUEREMAP=1
QUIT
+11 ; validate individual clinics
+12 IF $DATA(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC"))
Begin DoDot:3
+13 SET CLINICIEN=0
+14 FOR
SET CLINICIEN=$ORDER(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC",CLINICIEN))
if 'CLINICIEN
QUIT
Begin DoDot:4
+15 IF '$DATA(^SC(CLINICIEN,0))
DO ERRLOG^SDES2JSON(.ERRORS,52,"Invalid clinic: "_CLINICIEN)
+16 IF $$GET1^DIQ(44,CLINICIEN,2,"I")'="C"
DO ERRLOG^SDES2JSON(.ERRORS,52,"IEN "_CLINICIEN_" is not 'Clinic'.")
+17 IF $$GET1^DIQ(44,CLINICIEN,3.5,"I")'=DIVISIONIEN
DO ERRLOG^SDES2JSON(.ERRORS,52,"Clinic "_CLINICIEN_" is not associated with Division: "_DIVISIONIEN)
+18 IF $$INACTIVE^SDES2UTIL(CLINICIEN,DT)
DO ERRLOG^SDES2JSON(.ERRORS,52,"Inactive Clinic: "_CLINICIEN)
+19 SET CLINCNT=CLINCNT+1
End DoDot:4
End DoDot:3
End DoDot:2
+20 IF CLINCNT>20
SET QUEUEREMAP=1
End DoDot:1
QUIT
+21 ;
+22 IF $DATA(SDINPUT("CLINIC"))
Begin DoDot:1
+23 SET CLINICIEN=0
FOR
SET CLINIEN=$ORDER(SDINPUT("CLINIC",CLINICIEN))
if 'CLINICIEN
QUIT
Begin DoDot:2
+24 IF '$DATA(^SC(CLINICIEN,0))
DO ERRLOG^SDES2JSON(.ERRORS,52,"Invalid clinic: "_CLINICIEN)
+25 IF $$GET1^DIQ(44,CLINIEN,2,"I")'="C"
DO ERRLOG^SDES2JSON(.ERRORS,52,"IEN "_CLINICIEN_" is not 'Clinic'.")
+26 IF $$INACTIVE^SDES2UTIL(CLINICIEN,DT)
DO ERRLOG^SDES2JSON(.ERRORS,52,"Inactive Clinic: "_CLINICIEN)
+27 SET CLINCNT=CLINCNT+1
End DoDot:2
+28 IF CLINCNT>20
SET QUEUEREMAP=1
End DoDot:1
+29 QUIT
+30 ;
TASKREMAP(SDINPUT,STARTDATE,ENDDATE,TASKRES,SDUSER) ;
+1 NEW ZTDESC,ZTRTN,ZTIO,ZTSK,X,ZTDTH,ZTSAVE
+2 SET ZTDESC=""
+3 IF $DATA(SDINPUT("DIVISION","ALL"))
SET ZTDESC="Clinic Remap - All Divisions / All clinics"
+4 IF '$LENGTH(ZTDESC)
IF $DATA(SDINPUT("DIVISION"))
SET ZTDESC="Clinic Remap - Division List"
+5 IF '$LENGTH(ZTDESC)
IF $DATA(SDINPUT("CLINIC"))
SET ZTDESC="Clinic Remap - Clinic List"
+6 IF '$LENGTH(ZTDESC)
SET ZTDESC="Clinic Remap Background Process"
+7 SET ZTDTH=$$FMADD^XLFDT(DT,1)
+8 SET ZTDTH=ZTDTH_.02
SET ZTIO=""
SET ZTRTN="BACKGROUNDREMAP^SDES2REMAPUTIL"
SET ZTSAVE("*")=""
DO ^%ZTLOAD
+9 IF $DATA(ZTSK)
Begin DoDot:1
+10 SET TASKRES("ClinicRemap","Status")="Task "_ZTSK_" has been queued."
End DoDot:1
QUIT
+11 IF '$DATA(ZTSK)
Begin DoDot:1
+12 SET TASKRES("ClinicRemap","Status")="UNABLE TO QUEUE THIS JOB. Please contact the National Help Desk to report this issue."
End DoDot:1
+13 QUIT
BACKGROUNDREMAP ;
+1 NEW DIVISIONIEN,CLINICIEN,GBL,TMPCOUNT,DATETIME
+2 SET DATETIME=$$NOW^XLFDT
+3 SET GBL=$NAME(^TMP("SDES2REMAP",$JOB))
KILL @GBL
+4 SET (DIVISIONIEN,TMPCOUNT)=0
+5 ; all divisions
+6 ; build report header
+7 DO HEADER(.GBL,.TMPCOUNT)
+8 ;
+9 IF $DATA(SDINPUT("DIVISION","ALL"))
Begin DoDot:1
+10 SET CLINIEN=0
FOR
SET CLINIEN=$ORDER(^SC(CLINIEN))
if 'CLINIEN
QUIT
Begin DoDot:2
+11 if $$GET1^DIQ(44,CLINIEN,2,"I")'="C"
QUIT
+12 if $$INACTIVE^SDES2UTIL(CLINIEN,DT)
QUIT
+13 DO REMAPCLIN^SDES2REMAP(.GBL,CLINIEN,STARTDATE,ENDDATE,.TMPCOUNT)
End DoDot:2
+14 DO MAIL(GBL,SDUSER)
+15 KILL @GBL
End DoDot:1
QUIT
+16 ;
+17 ; process division list with clinics = all, or multiple individual clinics
+18 IF $ORDER(SDINPUT("DIVISION",0))
Begin DoDot:1
+19 FOR
SET DIVISIONIEN=$ORDER(SDINPUT("DIVISION",DIVISIONIEN))
if 'DIVISIONIEN
QUIT
Begin DoDot:2
+20 ; process all clinics
+21 IF $DATA(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC","ALL"))!('$DATA(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC")))
Begin DoDot:3
+22 SET CLINICIEN=0
+23 FOR
SET CLINICIEN=$ORDER(^SC(CLINICIEN))
if 'CLINICIEN
QUIT
Begin DoDot:4
+24 if '$$CLINDIVCHECK(DIVISIONIEN,CLINICIEN)
QUIT
+25 DO REMAPCLIN^SDES2REMAP(.GBL,CLINICIEN,STARTDATE,ENDDATE,.TMPCOUNT)
End DoDot:4
End DoDot:3
QUIT
+26 ; process clinics in the list
+27 SET CLINICIEN=0
+28 FOR
SET CLINICIEN=$ORDER(SDINPUT("DIVISION",DIVISIONIEN,"CLINIC",CLINICIEN))
if 'CLINICIEN
QUIT
Begin DoDot:3
+29 if '$$CLINDIVCHECK(DIVISIONIEN,CLINICIEN)
QUIT
End DoDot:3
End DoDot:2
+30 DO MAIL(GBL,SDUSER)
+31 KILL @GBL
End DoDot:1
QUIT
+32 ;
+33 ; process remap by clinic list
+34 IF $DATA(SDINPUT("CLINIC"))
Begin DoDot:1
+35 SET CLINIEN=0
FOR
SET CLINIEN=$ORDER(SDINPUT("CLINIC",CLINIEN))
if 'CLINIEN
QUIT
Begin DoDot:2
+36 if $$GET1^DIQ(44,CLINIEN,2,"I")'="C"
QUIT
+37 if $$INACTIVE^SDES2UTIL(CLINIEN,DT)
QUIT
+38 DO REMAPCLIN^SDES2REMAP(.GBL,CLINIEN,STARTDATE,ENDDATE,.TMPCOUNT)
End DoDot:2
+39 DO MAIL(GBL,SDUSER)
+40 KILL @GBL
End DoDot:1
QUIT
+41 QUIT
MAIL(GBL,USERDUZ) ;
+1 NEW XMTEXT,XMSUB,XMY,XMDUZ,DIFROM,USEREMAIL
+2 ; Send MailMan message
+3 SET XMTEXT="^TMP(""SDES2REMAP"","_$JOB_","
+4 SET XMSUB="REMAP CLINIC - Queued Remap results "_$$FMTE^XLFDT(DT)_" by: "_$$GET1^DIQ(200,USERDUZ,.01,"E")
+5 SET XMY(USERDUZ)=""
+6 SET USEREMAIL=$$GET1^DIQ(200,USERDUZ,.151,"E")
+7 IF USEREMAIL]""
SET XMY(USEREMAIL)=""
+8 DO ^XMD
+9 QUIT
CLINDIVCHECK(DIVIEN,CLINIEN) ;
+1 if $$GET1^DIQ(44,CLINICIEN,2,"I")'="C"
QUIT 0
+2 if $$INACTIVE^SDES2UTIL(CLINICIEN,DT)
QUIT 0
+3 IF $$GET1^DIQ(44,CLINICIEN,3.5,"I")'=DIVISIONIEN
QUIT 0
+4 QUIT 1
+5 ;
ACTIVEAPPTS(CLINIEN,REMAPDATE,FIRSTAPPTDTTM) ;
+1 NEW HASAPPTS,STARTDTTM,ENDDTTM,APPTDTTM,APPTIEN
+2 SET HASAPPTS=0
+3 SET FIRSTAPPTDTTM=$ORDER(^SC(CLINIEN,"S",REMAPDATE))
+4 IF FIRSTAPPTDTTM>(REMAPDATE_.9)
SET FIRSTAPPTDTTM=REMAPDATE
QUIT HASAPPTS
+5 SET APPTDTTM=REMAPDATE-.01
+6 FOR
SET APPTDTTM=$ORDER(^SC(CLINIEN,"S",APPTDTTM))
if 'APPTDTTM!($PIECE(APPTDTTM,".")>REMAPDATE)
QUIT
Begin DoDot:1
+7 SET APPTIEN=0
FOR
SET APPTIEN=$ORDER(^SC(CLINIEN,"S",APPTDTTM,1,APPTIEN))
if 'APPTIEN
QUIT
Begin DoDot:2
+8 IF $$GET1^DIQ(44.003,APPTIEN_","_APPTDTTM_","_CLINIEN_",",310,"I")="C"
QUIT
+9 SET HASAPPTS=1
End DoDot:2
End DoDot:1
+10 QUIT HASAPPTS
+11 ;
+1 SET TMPCOUNT=TMPCOUNT+1
+2 SET @GBL@(TMPCOUNT)=$$FMTE^XLFDT(DT)_" Clinic Remap Report "
+3 SET TMPCOUNT=TMPCOUNT+1
+4 SET @GBL@(TMPCOUNT)=" "
+5 SET TMPCOUNT=TMPCOUNT+1
+6 SET @GBL@(TMPCOUNT)=$$PAD($EXTRACT("Division",1,30),33)_$$PAD($EXTRACT("Clinic Name",1,30),33)_$$PAD("Clinic Date",19)_"Remark"
+7 SET TMPCOUNT=TMPCOUNT+1
+8 SET @GBL@(TMPCOUNT)=$$PAD($EXTRACT("=========",1,30),33)_$$PAD($EXTRACT("===========",1,30),33)_$$PAD("============",19)_"======"
+9 SET TMPCOUNT=TMPCOUNT+1
+10 SET @GBL@(TMPCOUNT)=" "
+11 QUIT
LOGDATA(GBL,CLINGBL,TMPCOUNT,CLINTMPCNT,CLINICNAME,DIVNAME,DATE,SCHEDONHOLIDAY,ACTIVEAPPTS,DAY,REMARK) ;
+1 NEW MESSAGE
+2 ; file the passed in remark and quit
+3 IF $LENGTH($GET(REMARK))
Begin DoDot:1
+4 SET TMPCOUNT=TMPCOUNT+1
+5 SET CLINTMPCNT=CLINTMPCNT+1
+6 SET (@GBL@(TMPCOUNT),@CLINGBL@(CLINTMPCNT))=$$PAD($EXTRACT(DIVNAME,1,30),33)_$$PAD($EXTRACT(CLINICNAME,1,30),33)_$$PAD($EXTRACT(DAY,1,3),4)_$$PAD($$FMTE^XLFDT(DATE),15)_REMARK
End DoDot:1
QUIT
+7 ; all other messages
+8 SET MESSAGE=$SELECT($DATA(^HOLIDAY(DATE,0))&ACTIVEAPPTS:"- Appts!",$DATA(^HOLIDAY(DATE,0))&'SCHEDONHOLIDAY:"- Inserted",1:"")
+9 IF MESSAGE]""
SET MESSAGE=MESSAGE
+10 if MESSAGE']""
QUIT
+11 ;S @GBL@(TMPCOUNT)=" "_$E(CLINICNAME,1,30)_$$PAD(CLINICNAME,33)_$$PAD($$FMTE^XLFDT(DATE),18)_REMARK
+12 SET TMPCOUNT=TMPCOUNT+1
+13 SET CLINTMPCNT=CLINTMPCNT+1
+14 SET (@GBL@(TMPCOUNT),@CLINGBL@(CLINTMPCNT))=$$PAD($EXTRACT(DIVNAME,1,30),33)_$$PAD($EXTRACT(CLINICNAME,1,30),33)_$$PAD($EXTRACT(DAY,1,3),4)_$$PAD($$FMTE^XLFDT(DATE),15)_MESSAGE
+15 QUIT
PAD(STRING,LENGTH) ;
+1 NEW NLENGTH,SPACE,I,RETSTRING,SPACES
+2 SET NLENGTH=$LENGTH(STRING)
+3 SET SPACES=LENGTH-NLENGTH
+4 SET RETSTRING=STRING
+5 FOR I=1:1:SPACES
SET RETSTRING=$GET(RETSTRING)_" "
+6 QUIT RETSTRING
