SDES2CLINUT ;ALB/BWF - SDES2 Clinic Save utilities ;JAN 5, 2023
;;5.3;Scheduling;**853,857,866,885**;Aug 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
Q
SAVEPROVIDERS(ERRORS,SDCLINIC,SDIEN) ;
N PROVIEN,ACTION,DELIEN,CURDEFPROV,DEFPROVIEN,FDA,NEWDEFIEN,FDA,SFIEN
S PROVIEN=0 F S PROVIEN=$O(SDCLINIC("PROVIDER",PROVIEN)) Q:'PROVIEN D
.S ACTION=$G(SDCLINIC("PROVIDER",PROVIEN))
.; delete provider
.I ACTION="@" D Q
..I '$D(^SC(SDIEN,"PR","B",PROVIEN)) Q
..S DELIEN=$O(^SC(SDIEN,"PR","B",PROVIEN,0)) Q:'DELIEN
..S FDA(44.1,DELIEN_","_SDIEN_",",.01)="@" D FILE^DIE(,"FDA") K FDA
.; default provider
.I $D(SDCLINIC("PROVIDER",PROVIEN,"DEFAULT")) D Q
..S CURDEFPROV=$$DEFPROV(SDIEN)
..; clear out current default provider
..I CURDEFPROV D
...S DEFPROVIEN=$O(^SC(SDIEN,"PR","B",CURDEFPROV,0))
...S FDA(44.1,DEFPROVIEN_","_SDIEN_",",.02)="" D FILE^DIE(,"FDA") K FDA
..; if the current provider exists, file it as default
..I $D(^SC(SDIEN,"PR","B",PROVIEN)) D Q
...S NEWDEFIEN=$O(^SC(SDIEN,"PR","B",PROVIEN,0))
...S FDA(44.1,NEWDEFIEN_","_SDIEN_",",.02)=1 D FILE^DIE(,"FDA") K FDA
..; if current provider is new, file it and set to default
..I '$D(^SC(SDIEN,"PR","B",PROVIEN)) D Q
...S FDA(44.1,"+1,"_SDIEN_",",.01)=PROVIEN
...S FDA(44.1,"+1,"_SDIEN_",",.02)=1
...D UPDATE^DIE(,"FDA") K FDA
.; remove default provider flag if the provider is passed in without the default designation
.I $D(^SC(SDIEN,"PR","B",PROVIEN)),'$D(SDCLINIC("PROVIDER",PROVIEN,"DEFAULT")) D Q
..S SFIEN=$O(^SC(SDIEN,"PR","B",PROVIEN,0))
..S FDA(44.1,SFIEN_","_SDIEN_",",.02)="" D FILE^DIE(,"FDA") Q
.; all other providers
.I $D(^SC(SDIEN,"PR","B",PROVIEN)) Q
.S FDA(44.1,"+1,"_SDIEN_",",.01)=PROVIEN D UPDATE^DIE(,"FDA") K FDA
Q
SAVEDIAG(ERRORS,SDCLINIC,SDIEN) ;
N DIAGCODE,ACTION,DIAGIEN,CURDEFDIAG,REMDIAGIEN,DEFDIAGIEN,FDA,DIAGSFIEN,SFIEN
S CURDEFDIAG=$$DEFDIAG(SDIEN)
S DIAGCODE="" F S DIAGCODE=$O(SDCLINIC("DIAGNOSIS",DIAGCODE)) Q:DIAGCODE="" D
.S DIAGIEN=$$CODEN^ICDEX(DIAGCODE,80),DIAGIEN=+$P(DIAGIEN,U)
.I DIAGIEN=-1 D ERRLOG^SDES2JSON(.ERRORS,85,DIAGCODE)
.S ACTION=$G(SDCLINIC("DIAGNOSIS",DIAGCODE))
.; delete diagnosis
.I ACTION="@" D Q
..I '$D(^SC(SDIEN,"DX","B",DIAGIEN)) Q
..S REMDIAGIEN=$O(^SC(SDIEN,"DX","B",DIAGIEN,0)) Q:'REMDIAGIEN
..S FDA(44.11,REMDIAGIEN_","_SDIEN_",",.01)="@" D FILE^DIE(,"FDA") K FDA Q
.; Default diagnosis
.I $D(SDCLINIC("DIAGNOSIS",DIAGCODE,"DEFAULT")) D Q
..; remove the current default
..I CURDEFDIAG D
...S DEFDIAGIEN=$O(^SC(SDIEN,"DX","B",CURDEFDIAG,0)) Q:'DEFDIAGIEN
...S FDA(44.11,DEFDIAGIEN_","_SDIEN_",",.02)="" D FILE^DIE(,"FDA") K FDA
..; if the current diagnosis exists, set it to default
..I $D(^SC(SDIEN,"DX","B",DIAGIEN)) D Q
...S DIAGSFIEN=$O(^SC(SDIEN,"DX","B",DIAGIEN,0)) Q:'DIAGSFIEN
...S FDA(44.11,DIAGSFIEN_","_SDIEN_",",.02)=1 D FILE^DIE(,"FDA") K FDA
..; if this is a new diagnosis, add it as default
..I '$D(^SC(SDIEN,"DX","B",DIAGIEN)) D
...S FDA(44.11,"+1,"_SDIEN_",",.01)=DIAGIEN
...S FDA(44.11,"+1,"_SDIEN_",",.02)=1
...D UPDATE^DIE(,"FDA") K FDA
.; remove default diagnosis flag if the diagnosis is passed in without the default designation
.I $D(^SC(SDIEN,"DX","B",DIAGIEN)),'$D(SDCLINIC("DIAGNOSIS",DIAGCODE,"DEFAULT")) D Q
..S SFIEN=$O(^SC(SDIEN,"DX","B",DIAGIEN,0))
..S FDA(44.11,SFIEN_","_SDIEN_",",.02)="" D FILE^DIE(,"FDA") K FDA
.; All other diagnosis codes
.I $D(^SC(SDIEN,"DX","B",DIAGIEN)) Q
.S FDA(44.11,"+1,"_SDIEN_",",.01)=DIAGIEN D UPDATE^DIE(,"FDA") K FDA
Q
; CLINDATA("SPECIAL INSTRUCTION",COUNTER)=IEN|TEXT - to edit existing entry
; CLINDATA("SPECIAL INSTRUCTION",COUNTER)=IEN|@ for deletion
; CLINDATA("SPECIAL INSTRUCTION",COUNTER)=""|TEXT to add new entry
;
SAVEINSTRUCT(ERRORS,CLINDATA,SDIEN) ;
N INSTRUCT,INSTDATA,INSLOOP,FDA,INSTTEXT,INSTIEN,FILERR
S INSTRUCT=0 F S INSTRUCT=$O(CLINDATA("SPECIAL INSTRUCTIONS",INSTRUCT)) Q:'INSTRUCT D
.S INSTDATA=$G(CLINDATA("SPECIAL INSTRUCTIONS",INSTRUCT))
.S INSTIEN=$P(INSTDATA,"|")
.S INSTTEXT=$P(INSTDATA,"|",2,99)
.I INSTTEXT="@" D Q
..; cannot delete an entry that does not exist
..I '$D(^SC(SDIEN,"SI",INSTIEN)) Q
..S FDA(44.03,INSTIEN_","_SDIEN_",",.01)="@" D FILE^DIE(,"FDA") K FDA
.I INSTIEN,INSTTEXT'="@" D Q
..I '$D(^SC(SDIEN,"SI",INSTIEN)) S FDA(44.03,"+1,"_SDIEN_",",.01)=INSTTEXT D UPDATE^DIE(,"FDA") K FDA Q
..S FDA(44.03,INSTIEN_","_SDIEN_",",.01)=INSTTEXT D FILE^DIE(,"FDA","FILERR") K FDA
.I 'INSTIEN S FDA(44.03,"+1,"_SDIEN_",",.01)=INSTTEXT D UPDATE^DIE(,"FDA") K FDA
Q
SAVEPRIVUSERS(ERRORS,CLINDATA,SDIEN) ;
N PUSER,USERACT,NEWIEN
S PUSER=0 F S PUSER=$O(CLINDATA("PRIVILEGED USER",PUSER)) Q:'PUSER D
.S USERACT=$G(CLINDATA("PRIVILEGED USER",PUSER))
.I USERACT="@" S FDA(44.04,PUSER_","_SDIEN_",",.01)="@" D FILE^DIE(,"FDA") K FDA Q
.S FDA(44.04,"+1,"_SDIEN_",",.01)=PUSER
.S NEWIEN(1)=PUSER
.D UPDATE^DIE(,"FDA","NEWIEN") K FDA
Q
;
ADDHASH2CLIN(SDCLINICIEN) ; add HASH to clinic after creation of clinic
N SDHASH,SDHASHDATE,SDCLNJSON,SDCLNSREC
D BLDCLNREC(.SDCLNSREC,SDCLINICIEN)
D BUILDJSON^SDES2JSON(.SDCLNJSON,.SDCLNSREC)
D UPDATECLINICHASH(SDCLINICIEN,.SDHASH,.SDHASHDATE,.SDCLNJSON)
Q
;
BLDCLNREC(SDCLNSREC,SDCLNIEN) ;Get Clinic data
;
N SDFIELDS,SDDATA,SDMSG,SDX,SDC,SDTIMEZONE,SDTIMEZONEEXC,SDUSRCNT,SDUSRIEN,SDSTATUSINACTIVE,SDSTATUS,SDECI
S SDECI=$G(SDECI,0)
S SDFIELDS=".01;1;3.5;8;9;10;24;60;61;62;63;1914;2502;2504;2505;2506;2507;2802;99;99.1;2000;2000.5;2508;2509;2510;2511;2801;30;2001;2002;1918.5;2503;2500;1916;1918;20;21;1912;1913;1917"
D GETS^DIQ(44,SDCLNIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
S SDECI=SDECI+1
S SDCLNSREC("Clinic","ClinicIEN")=$G(SDCLNIEN) ;Clinic IEN
S SDCLNSREC("Clinic","ClinicName")=$G(SDDATA(44,SDCLNIEN_",",.01,"E")) ;Clinic Name
S SDCLNSREC("Clinic","Abbreviation")=$G(SDDATA(44,SDCLNIEN_",",1,"E")) ;Clinic Abbreviation
S SDCLNSREC("Clinic","PatientFriendlyName")=$G(SDDATA(44,SDCLNIEN_",",60,"E")) ;Patient Friendly Name
S SDCLNSREC("Clinic","StationNumber")=$$STATIONNUMBER^SDESUTIL(SDCLNIEN) ;Clinic station number
S SDCLNSREC("Clinic","MeetsAtThisFacility")=$G(SDDATA(44,SDCLNIEN_",",2504,"E")) ;Clinic meets at this facility?
S SDCLNSREC("Clinic","AllowPatScheduling")=$G(SDDATA(44,SDCLNIEN_",",61,"E")) ;Allow Direct Patient Scheduling?
S SDCLNSREC("Clinic","DisplayClinicAppt")=$G(SDDATA(44,SDCLNIEN_",",62,"E")) ;DISPLAY CLIN APPT TO PATIENTS?
S SDCLNSREC("Clinic","VeteranSelfCancel")=$G(SDDATA(44,SDCLNIEN_",",63,"E")) ;VETERAN SELF-CANCEL
S SDCLNSREC("Clinic","Service")=$G(SDDATA(44,SDCLNIEN_",",9,"E")) ;Service
S SDCLNSREC("Clinic","NonCountClinic")=$G(SDDATA(44,SDCLNIEN_",",2502,"E")) ;NON-COUNT CLINIC? (Y OR N)
S SDCLNSREC("Clinic","DivisionIEN")=$G(SDDATA(44,SDCLNIEN_",",3.5,"I")) ;Division
S SDCLNSREC("Clinic","DivisionName")=$G(SDDATA(44,SDCLNIEN_",",3.5,"E")) ;Division
S SDSTATUS=$$INACTIVE^SDESUTIL(SDCLNIEN,DT),SDSTATUS=$S(SDSTATUS=0:"ACTIVE",1:"INACTIVE") ;Get status of clinic
S SDCLNSREC("Clinic","ClinicStatus")=SDSTATUS
S SDCLNSREC("Clinic","StopCodeName")=$G(SDDATA(44,SDCLNIEN_",",8,"E")) ;Stop Code Name
S SDCLNSREC("Clinic","StopCodeNum")=$G(SDDATA(44,SDCLNIEN_",",8,"I")) ;Stop Code IEN
S SDCLNSREC("Clinic","StopCodeAMISNum")=$$GET1^DIQ(40.7,$G(SDDATA(44,SDCLNIEN_",",8,"I")),1) ;Stop Code AMIS Number
S SDCLNSREC("Clinic","DefaultApptType")=$G(SDDATA(44,SDCLNIEN_",",2507,"E")) ;Default Appointment type
S SDCLNSREC("Clinic","AdminInpatientMeds")=$G(SDDATA(44,SDCLNIEN_",",2802,"E")) ;ADMINISTER INPATIENT MEDS?
S SDCLNSREC("Clinic","Telephone")=$G(SDDATA(44,SDCLNIEN_",",99,"E")) ;TELEPHONE
S SDCLNSREC("Clinic","TelephoneExtension")=$G(SDDATA(44,SDCLNIEN_",",99.1,"E")) ;TELEPHONE Extension
S SDCLNSREC("Clinic","ReqXrayFilms")=$G(SDDATA(44,SDCLNIEN_",",2000,"E")) ;REQUIRE X-RAY FILMS?
S SDCLNSREC("Clinic","ReqActionProfiles")=$G(SDDATA(44,SDCLNIEN_",",2000.5,"E")) ;REQUIRE ACTION PROFILES?
S SDCLNSREC("Clinic","NoShowLetter")=$G(SDDATA(44,SDCLNIEN_",",2508,"E")) ;NO SHOW LETTER
S SDCLNSREC("Clinic","NoShowLetterIEN")=$G(SDDATA(44,SDCLNIEN_",",2508,"I")) ;NO SHOW IEN
S SDCLNSREC("Clinic","PreApptLetter")=$G(SDDATA(44,SDCLNIEN_",",2509,"E")) ;PRE-APPOINTMENT LETTER
S SDCLNSREC("Clinic","CancelLetter")=$G(SDDATA(44,SDCLNIEN_",",2510,"E")) ;CLINIC CANCELLATION LETTER
S SDCLNSREC("Clinic","ApptCancelLetter")=$G(SDDATA(44,SDCLNIEN_",",2511,"E")) ;APPT. CANCELLATION LETTER
S SDCLNSREC("Clinic","CheckinCheckoutTime")=$G(SDDATA(44,SDCLNIEN_",",24,"E")) ;ASK FOR CHECK IN/OUT TIME
S SDCLNSREC("Clinic","DefaultToPCPractitioner")=$G(SDDATA(44,SDCLNIEN_",",2801,"E")) ;DEFAULT TO PC PRACTITIONER?
S SDCLNSREC("Clinic","WorkloadValidationCheckout")=$G(SDDATA(44,SDCLNIEN_",",30,"E")) ;WORKLOAD VALIDATION AT CHK OUT
S SDCLNSREC("Clinic","AllowableConsecutiveNoShows")=$G(SDDATA(44,SDCLNIEN_",",2001,"E")) ;ALLOWABLE CONSECUTIVE NO-SHOWS
S SDCLNSREC("Clinic","MaxDaysForFutureBooking")=$G(SDDATA(44,SDCLNIEN_",",2002,"E")) ;MAX # DAYS FOR FUTURE BOOKING
S SDCLNSREC("Clinic","HolidaySchedule")=$G(SDDATA(44,SDCLNIEN_",",1918.5,"E")) ;SCHEDULE ON HOLIDAYS?
S SDCLNSREC("Clinic","CreditStopCodeNum")=$G(SDDATA(44,SDCLNIEN_",",2503,"I")) ;CREDIT STOP IEN
S SDCLNSREC("Clinic","CreditStopCodeName")=$G(SDDATA(44,SDCLNIEN_",",2503,"E")) ;CREDIT STOP NAME
S SDCLNSREC("Clinic","CreditStopCodeAMISNum")=$$GET1^DIQ(40.7,$G(SDDATA(44,SDCLNIEN_",",2503,"I")),1) ;Credit Stop Code AMIS Number
S SDCLNSREC("Clinic","ProhibitAccessToClinic")=$G(SDDATA(44,SDCLNIEN_",",2500,"E")) ;PROHIBIT ACCESS TO CLINIC?
S SDCLNSREC("Clinic","PhysicalLocation")=$G(SDDATA(44,SDCLNIEN_",",10,"E")) ;PHYSICAL LOCATION
S SDCLNSREC("Clinic","Principal")=$G(SDDATA(44,SDCLNIEN_",",1916,"E")) ;PRINCIPAL Clinic
S SDCLNSREC("Clinic","OverbooksPerDayMax")=$G(SDDATA(44,SDCLNIEN_",",1918,"E")) ;OVERBOOKS/DAY MAXIMUM
S SDCLNSREC("Clinic","ECheckinAllowed")=$G(SDDATA(44,SDCLNIEN_",",20,"E")) ;E-CHECKIN ALLOWED
S SDCLNSREC("Clinic","PreCheckinAllowed")=$G(SDDATA(44,SDCLNIEN_",",21,"E")) ;PRE-CHECKIN ALLOWED NO
S SDCLNSREC("Clinic","LengthOfAppt")=$G(SDDATA(44,SDCLNIEN_",",1912,"E")) ;LENGTH OF APP'T
S SDCLNSREC("Clinic","VariableApptLength")=$G(SDDATA(44,SDCLNIEN_",",1913,"E")) ;VARIABLE APP'NTMENT LENGTH
S SDCLNSREC("Clinic","IncrementsPerHr")=$G(SDDATA(44,SDCLNIEN_",",1917,"E")) ;DISPLAY INCREMENTS PER HOUR
S SDCLNSREC("Clinic","HourClinicDisplayBegins")=$S($G(SDDATA(44,SDCLNIEN_",",1914,"E"))'="":$G(SDDATA(44,SDCLNIEN_",",1914,"E")),1:8) ; HOUR CLINIC DISPLAY BEGINS
S SDTIMEZONE=$$TIMEZONEDATA^SDESUTIL($G(SDCLNIEN)),SDTIMEZONEEXC=$P($G(SDTIMEZONE),U,3),SDTIMEZONE=$P($G(SDTIMEZONE),U)
S SDCLNSREC("Clinic","Timezone")=SDTIMEZONE
S SDCLNSREC("Clinic","TimezoneException")=SDTIMEZONEEXC
S SDCLNSREC("Clinic","Inactivate Date")=$$FMTISO^SDAMUTDT($G(SDDATA(44,SDCLNIEN_",",2505,"I"))) ;Inactivate Date
S SDCLNSREC("Clinic","Reactivate Date")=$$FMTISO^SDAMUTDT($G(SDDATA(44,SDCLNIEN_",",2506,"I"))) ;Reactivate Date
; Get CHAR4 Data
N CHAR4
S CHAR4=$$CHAR4^SDESUTIL($G(SDDATA(44,SDCLNIEN_",",.01,"E")))
S SDCLNSREC("Clinic","CHAR4")=CHAR4
; Special Instructions Multiple
S SDX="",SDC=0
S SDFIELDS="1910*"
K SDDATA,SDMSG
D GETS^DIQ(44,SDCLNIEN_",",SDFIELDS,"E","SDDATA","SDMSG")
F S SDX=$O(SDDATA(44.03,SDX)) Q:SDX="" D
.S SDC=SDC+1
.S SDCLNSREC("Clinic","Special Instructions",SDC)=$G(SDDATA(44.03,SDX,.01,"E"))
; Providers Multiple
S SDX="",SDC=0
S SDFIELDS="2600*"
K SDDATA,SDMSG
D GETS^DIQ(44,SDCLNIEN_",",SDFIELDS,"E","SDDATA","SDMSG")
F S SDX=$O(SDDATA(44.1,SDX)) Q:SDX="" D
.S SDC=SDC+1
.S SDCLNSREC("Clinic","Provider",SDC,"Name")=$G(SDDATA(44.1,SDX,.01,"E"))
.S SDCLNSREC("Clinic","Provider",SDC,"DefaultForClinic")=$G(SDDATA(44.1,SDX,.02,"E"))
; Diagnosis Multiple
S SDX="",SDC=0
S SDFIELDS="2700*"
K SDDATA,SDMSG
D GETS^DIQ(44,SDCLNIEN_",",SDFIELDS,"E","SDDATA","SDMSG")
F S SDX=$O(SDDATA(44.11,SDX)) Q:SDX="" D
.S SDC=SDC+1
.S SDCLNSREC("Clinic","Diagnosis",SDC,"Code")=$G(SDDATA(44.11,SDX,.01,"E"))
.S SDCLNSREC("Clinic","Diagnosis",SDC,"DefaultForClinic")=$G(SDDATA(44.11,SDX,.02,"E"))
; Return all Privileged Users
S (SDUSRCNT,SDUSRIEN)=0
F S SDUSRIEN=$O(^SC(SDCLNIEN,"SDPRIV",SDUSRIEN)) Q:'SDUSRIEN D
.S SDUSRCNT=SDUSRCNT+1
.S SDCLNSREC("Clinic","PrivilegedUser",SDUSRCNT,"IEN")=SDUSRIEN
.S SDCLNSREC("Clinic","PrivilegedUser",SDUSRCNT,"Name")=$$GET1^DIQ(44.04,SDUSRIEN_","_SDCLNIEN,.01)
;I USRCNT=0 S SDCLNSREC("Clinic","PrivilegedUser","Error",1)="No privileged users are found."
;
I $D(SDCLNSREC("Clinic")) Q 1
S SDCLNSREC("Clinic")=""
Q 0
;
UPDATECLINICHASH(SDCLIN,SDHASH,SDHASHDATE,SDCLNJSON) ;update clinic with new hash
N SDFDA,SDFDAERR
S SDHASH=$$SHAN^XLFSHAN(160,SDCLNJSON(1))
S SDHASHDATE=$$NOW^XLFDT
S SDFDA(44,SDCLIN_",",2900)=SDHASH
S SDFDA(44,SDCLIN_",",2901)=SDHASHDATE
D FILE^DIE(,"SDFDA","FDAERR") K FDA
Q
;
ADDRESOURCE(SDCLINICIEN) ; NEED IEN TO FILE RESOURCE ?
N SDABBR,SDDATA,SDDI,SDFDA,SDFOUND,SDI,SDNOD,SDRT,SDFIELDS
S SDFOUND=0
S SDI="" F S SDI=$O(^SDEC(409.831,"ALOC",SDCLINICIEN,SDI)) Q:SDI="" D Q:SDFOUND=1
. S SDNOD=$G(^SDEC(409.831,SDI,0))
. S SDRT=$P(SDNOD,U,11)
. I $P(SDRT,";",2)="SC(",$P(SDRT,";",1)=SDCLINICIEN S SDFOUND=1
S SDI=$S(SDFOUND=1:SDI,1:"+1")
S SDFIELDS=".01;1;1917" ;alb/sat 658 - add field 1
D GETS^DIQ(44,SDCLINICIEN_",",SDFIELDS,"IE","SDDATA")
S SDFDA(409.831,SDI_",",.01)=SDDATA(44,SDCLINICIEN_",",.01,"E")
S SDDI=SDDATA(44,SDCLINICIEN_",",1917,"E") S SDFDA(409.831,SDI_",",.03)=$E(SDDI,1,2)
S SDABBR=SDDATA(44,SDCLINICIEN_",",1,"E") S:SDABBR'="" SDFDA(409.831,SDI_",",.011)=SDABBR ;alb/sat 658 - add abbreviation
S SDFDA(409.831,SDI_",",.04)=SDCLINICIEN
S SDFDA(409.831,SDI_",",.012)=SDCLINICIEN_";SC("
S SDFDA(409.831,SDI_",",.015)=$E($$NOW^XLFDT,1,12)
S SDFDA(409.831,SDI_",",.016)=DUZ
D UPDATE^DIE("","SDFDA")
Q
;
DEFPROV(CLINIEN) ;
N DPROV
S DPROV=$O(^SC("ADPR",CLINIEN,0)) Q:'DPROV 0
Q $$GET1^DIQ(44.1,DPROV_","_CLINIEN_",",.01,"I")
;
DEFDIAG(CLINIEN) ;
N DDIAG
S DDIAG=$O(^SC("ADDX",CLINIEN,0)) Q:'DDIAG 0
Q $$GET1^DIQ(44.11,DDIAG_","_CLINIEN_",",.01,"I")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2CLINUT 14264 printed Oct 16, 2024@18:54:05 Page 2
SDES2CLINUT ;ALB/BWF - SDES2 Clinic Save utilities ;JAN 5, 2023
+1 ;;5.3;Scheduling;**853,857,866,885**;Aug 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
SAVEPROVIDERS(ERRORS,SDCLINIC,SDIEN) ;
+1 NEW PROVIEN,ACTION,DELIEN,CURDEFPROV,DEFPROVIEN,FDA,NEWDEFIEN,FDA,SFIEN
+2 SET PROVIEN=0
FOR
SET PROVIEN=$ORDER(SDCLINIC("PROVIDER",PROVIEN))
if 'PROVIEN
QUIT
Begin DoDot:1
+3 SET ACTION=$GET(SDCLINIC("PROVIDER",PROVIEN))
+4 ; delete provider
+5 IF ACTION="@"
Begin DoDot:2
+6 IF '$DATA(^SC(SDIEN,"PR","B",PROVIEN))
QUIT
+7 SET DELIEN=$ORDER(^SC(SDIEN,"PR","B",PROVIEN,0))
if 'DELIEN
QUIT
+8 SET FDA(44.1,DELIEN_","_SDIEN_",",.01)="@"
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:2
QUIT
+9 ; default provider
+10 IF $DATA(SDCLINIC("PROVIDER",PROVIEN,"DEFAULT"))
Begin DoDot:2
+11 SET CURDEFPROV=$$DEFPROV(SDIEN)
+12 ; clear out current default provider
+13 IF CURDEFPROV
Begin DoDot:3
+14 SET DEFPROVIEN=$ORDER(^SC(SDIEN,"PR","B",CURDEFPROV,0))
+15 SET FDA(44.1,DEFPROVIEN_","_SDIEN_",",.02)=""
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:3
+16 ; if the current provider exists, file it as default
+17 IF $DATA(^SC(SDIEN,"PR","B",PROVIEN))
Begin DoDot:3
+18 SET NEWDEFIEN=$ORDER(^SC(SDIEN,"PR","B",PROVIEN,0))
+19 SET FDA(44.1,NEWDEFIEN_","_SDIEN_",",.02)=1
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:3
QUIT
+20 ; if current provider is new, file it and set to default
+21 IF '$DATA(^SC(SDIEN,"PR","B",PROVIEN))
Begin DoDot:3
+22 SET FDA(44.1,"+1,"_SDIEN_",",.01)=PROVIEN
+23 SET FDA(44.1,"+1,"_SDIEN_",",.02)=1
+24 DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:3
QUIT
End DoDot:2
QUIT
+25 ; remove default provider flag if the provider is passed in without the default designation
+26 IF $DATA(^SC(SDIEN,"PR","B",PROVIEN))
IF '$DATA(SDCLINIC("PROVIDER",PROVIEN,"DEFAULT"))
Begin DoDot:2
+27 SET SFIEN=$ORDER(^SC(SDIEN,"PR","B",PROVIEN,0))
+28 SET FDA(44.1,SFIEN_","_SDIEN_",",.02)=""
DO FILE^DIE(,"FDA")
QUIT
End DoDot:2
QUIT
+29 ; all other providers
+30 IF $DATA(^SC(SDIEN,"PR","B",PROVIEN))
QUIT
+31 SET FDA(44.1,"+1,"_SDIEN_",",.01)=PROVIEN
DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:1
+32 QUIT
SAVEDIAG(ERRORS,SDCLINIC,SDIEN) ;
+1 NEW DIAGCODE,ACTION,DIAGIEN,CURDEFDIAG,REMDIAGIEN,DEFDIAGIEN,FDA,DIAGSFIEN,SFIEN
+2 SET CURDEFDIAG=$$DEFDIAG(SDIEN)
+3 SET DIAGCODE=""
FOR
SET DIAGCODE=$ORDER(SDCLINIC("DIAGNOSIS",DIAGCODE))
if DIAGCODE=""
QUIT
Begin DoDot:1
+4 SET DIAGIEN=$$CODEN^ICDEX(DIAGCODE,80)
SET DIAGIEN=+$PIECE(DIAGIEN,U)
+5 IF DIAGIEN=-1
DO ERRLOG^SDES2JSON(.ERRORS,85,DIAGCODE)
+6 SET ACTION=$GET(SDCLINIC("DIAGNOSIS",DIAGCODE))
+7 ; delete diagnosis
+8 IF ACTION="@"
Begin DoDot:2
+9 IF '$DATA(^SC(SDIEN,"DX","B",DIAGIEN))
QUIT
+10 SET REMDIAGIEN=$ORDER(^SC(SDIEN,"DX","B",DIAGIEN,0))
if 'REMDIAGIEN
QUIT
+11 SET FDA(44.11,REMDIAGIEN_","_SDIEN_",",.01)="@"
DO FILE^DIE(,"FDA")
KILL FDA
QUIT
End DoDot:2
QUIT
+12 ; Default diagnosis
+13 IF $DATA(SDCLINIC("DIAGNOSIS",DIAGCODE,"DEFAULT"))
Begin DoDot:2
+14 ; remove the current default
+15 IF CURDEFDIAG
Begin DoDot:3
+16 SET DEFDIAGIEN=$ORDER(^SC(SDIEN,"DX","B",CURDEFDIAG,0))
if 'DEFDIAGIEN
QUIT
+17 SET FDA(44.11,DEFDIAGIEN_","_SDIEN_",",.02)=""
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:3
+18 ; if the current diagnosis exists, set it to default
+19 IF $DATA(^SC(SDIEN,"DX","B",DIAGIEN))
Begin DoDot:3
+20 SET DIAGSFIEN=$ORDER(^SC(SDIEN,"DX","B",DIAGIEN,0))
if 'DIAGSFIEN
QUIT
+21 SET FDA(44.11,DIAGSFIEN_","_SDIEN_",",.02)=1
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:3
QUIT
+22 ; if this is a new diagnosis, add it as default
+23 IF '$DATA(^SC(SDIEN,"DX","B",DIAGIEN))
Begin DoDot:3
+24 SET FDA(44.11,"+1,"_SDIEN_",",.01)=DIAGIEN
+25 SET FDA(44.11,"+1,"_SDIEN_",",.02)=1
+26 DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:3
End DoDot:2
QUIT
+27 ; remove default diagnosis flag if the diagnosis is passed in without the default designation
+28 IF $DATA(^SC(SDIEN,"DX","B",DIAGIEN))
IF '$DATA(SDCLINIC("DIAGNOSIS",DIAGCODE,"DEFAULT"))
Begin DoDot:2
+29 SET SFIEN=$ORDER(^SC(SDIEN,"DX","B",DIAGIEN,0))
+30 SET FDA(44.11,SFIEN_","_SDIEN_",",.02)=""
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:2
QUIT
+31 ; All other diagnosis codes
+32 IF $DATA(^SC(SDIEN,"DX","B",DIAGIEN))
QUIT
+33 SET FDA(44.11,"+1,"_SDIEN_",",.01)=DIAGIEN
DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:1
+34 QUIT
+35 ; CLINDATA("SPECIAL INSTRUCTION",COUNTER)=IEN|TEXT - to edit existing entry
+36 ; CLINDATA("SPECIAL INSTRUCTION",COUNTER)=IEN|@ for deletion
+37 ; CLINDATA("SPECIAL INSTRUCTION",COUNTER)=""|TEXT to add new entry
+38 ;
SAVEINSTRUCT(ERRORS,CLINDATA,SDIEN) ;
+1 NEW INSTRUCT,INSTDATA,INSLOOP,FDA,INSTTEXT,INSTIEN,FILERR
+2 SET INSTRUCT=0
FOR
SET INSTRUCT=$ORDER(CLINDATA("SPECIAL INSTRUCTIONS",INSTRUCT))
if 'INSTRUCT
QUIT
Begin DoDot:1
+3 SET INSTDATA=$GET(CLINDATA("SPECIAL INSTRUCTIONS",INSTRUCT))
+4 SET INSTIEN=$PIECE(INSTDATA,"|")
+5 SET INSTTEXT=$PIECE(INSTDATA,"|",2,99)
+6 IF INSTTEXT="@"
Begin DoDot:2
+7 ; cannot delete an entry that does not exist
+8 IF '$DATA(^SC(SDIEN,"SI",INSTIEN))
QUIT
+9 SET FDA(44.03,INSTIEN_","_SDIEN_",",.01)="@"
DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:2
QUIT
+10 IF INSTIEN
IF INSTTEXT'="@"
Begin DoDot:2
+11 IF '$DATA(^SC(SDIEN,"SI",INSTIEN))
SET FDA(44.03,"+1,"_SDIEN_",",.01)=INSTTEXT
DO UPDATE^DIE(,"FDA")
KILL FDA
QUIT
+12 SET FDA(44.03,INSTIEN_","_SDIEN_",",.01)=INSTTEXT
DO FILE^DIE(,"FDA","FILERR")
KILL FDA
End DoDot:2
QUIT
+13 IF 'INSTIEN
SET FDA(44.03,"+1,"_SDIEN_",",.01)=INSTTEXT
DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:1
+14 QUIT
SAVEPRIVUSERS(ERRORS,CLINDATA,SDIEN) ;
+1 NEW PUSER,USERACT,NEWIEN
+2 SET PUSER=0
FOR
SET PUSER=$ORDER(CLINDATA("PRIVILEGED USER",PUSER))
if 'PUSER
QUIT
Begin DoDot:1
+3 SET USERACT=$GET(CLINDATA("PRIVILEGED USER",PUSER))
+4 IF USERACT="@"
SET FDA(44.04,PUSER_","_SDIEN_",",.01)="@"
DO FILE^DIE(,"FDA")
KILL FDA
QUIT
+5 SET FDA(44.04,"+1,"_SDIEN_",",.01)=PUSER
+6 SET NEWIEN(1)=PUSER
+7 DO UPDATE^DIE(,"FDA","NEWIEN")
KILL FDA
End DoDot:1
+8 QUIT
+9 ;
ADDHASH2CLIN(SDCLINICIEN) ; add HASH to clinic after creation of clinic
+1 NEW SDHASH,SDHASHDATE,SDCLNJSON,SDCLNSREC
+2 DO BLDCLNREC(.SDCLNSREC,SDCLINICIEN)
+3 DO BUILDJSON^SDES2JSON(.SDCLNJSON,.SDCLNSREC)
+4 DO UPDATECLINICHASH(SDCLINICIEN,.SDHASH,.SDHASHDATE,.SDCLNJSON)
+5 QUIT
+6 ;
BLDCLNREC(SDCLNSREC,SDCLNIEN) ;Get Clinic data
+1 ;
+2 NEW SDFIELDS,SDDATA,SDMSG,SDX,SDC,SDTIMEZONE,SDTIMEZONEEXC,SDUSRCNT,SDUSRIEN,SDSTATUSINACTIVE,SDSTATUS,SDECI
+3 SET SDECI=$GET(SDECI,0)
+4 SET SDFIELDS=".01;1;3.5;8;9;10;24;60;61;62;63;1914;2502;2504;2505;2506;2507;2802;99;99.1;2000;2000.5;2508;2509;2510;2511;2801;30;2001;2002;1918.5;2503;2500;1916;1918;20;21;1912;1913;1917"
+5 DO GETS^DIQ(44,SDCLNIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
+6 SET SDECI=SDECI+1
+7 ;Clinic IEN
SET SDCLNSREC("Clinic","ClinicIEN")=$GET(SDCLNIEN)
+8 ;Clinic Name
SET SDCLNSREC("Clinic","ClinicName")=$GET(SDDATA(44,SDCLNIEN_",",.01,"E"))
+9 ;Clinic Abbreviation
SET SDCLNSREC("Clinic","Abbreviation")=$GET(SDDATA(44,SDCLNIEN_",",1,"E"))
+10 ;Patient Friendly Name
SET SDCLNSREC("Clinic","PatientFriendlyName")=$GET(SDDATA(44,SDCLNIEN_",",60,"E"))
+11 ;Clinic station number
SET SDCLNSREC("Clinic","StationNumber")=$$STATIONNUMBER^SDESUTIL(SDCLNIEN)
+12 ;Clinic meets at this facility?
SET SDCLNSREC("Clinic","MeetsAtThisFacility")=$GET(SDDATA(44,SDCLNIEN_",",2504,"E"))
+13 ;Allow Direct Patient Scheduling?
SET SDCLNSREC("Clinic","AllowPatScheduling")=$GET(SDDATA(44,SDCLNIEN_",",61,"E"))
+14 ;DISPLAY CLIN APPT TO PATIENTS?
SET SDCLNSREC("Clinic","DisplayClinicAppt")=$GET(SDDATA(44,SDCLNIEN_",",62,"E"))
+15 ;VETERAN SELF-CANCEL
SET SDCLNSREC("Clinic","VeteranSelfCancel")=$GET(SDDATA(44,SDCLNIEN_",",63,"E"))
+16 ;Service
SET SDCLNSREC("Clinic","Service")=$GET(SDDATA(44,SDCLNIEN_",",9,"E"))
+17 ;NON-COUNT CLINIC? (Y OR N)
SET SDCLNSREC("Clinic","NonCountClinic")=$GET(SDDATA(44,SDCLNIEN_",",2502,"E"))
+18 ;Division
SET SDCLNSREC("Clinic","DivisionIEN")=$GET(SDDATA(44,SDCLNIEN_",",3.5,"I"))
+19 ;Division
SET SDCLNSREC("Clinic","DivisionName")=$GET(SDDATA(44,SDCLNIEN_",",3.5,"E"))
+20 ;Get status of clinic
SET SDSTATUS=$$INACTIVE^SDESUTIL(SDCLNIEN,DT)
SET SDSTATUS=$SELECT(SDSTATUS=0:"ACTIVE",1:"INACTIVE")
+21 SET SDCLNSREC("Clinic","ClinicStatus")=SDSTATUS
+22 ;Stop Code Name
SET SDCLNSREC("Clinic","StopCodeName")=$GET(SDDATA(44,SDCLNIEN_",",8,"E"))
+23 ;Stop Code IEN
SET SDCLNSREC("Clinic","StopCodeNum")=$GET(SDDATA(44,SDCLNIEN_",",8,"I"))
+24 ;Stop Code AMIS Number
SET SDCLNSREC("Clinic","StopCodeAMISNum")=$$GET1^DIQ(40.7,$GET(SDDATA(44,SDCLNIEN_",",8,"I")),1)
+25 ;Default Appointment type
SET SDCLNSREC("Clinic","DefaultApptType")=$GET(SDDATA(44,SDCLNIEN_",",2507,"E"))
+26 ;ADMINISTER INPATIENT MEDS?
SET SDCLNSREC("Clinic","AdminInpatientMeds")=$GET(SDDATA(44,SDCLNIEN_",",2802,"E"))
+27 ;TELEPHONE
SET SDCLNSREC("Clinic","Telephone")=$GET(SDDATA(44,SDCLNIEN_",",99,"E"))
+28 ;TELEPHONE Extension
SET SDCLNSREC("Clinic","TelephoneExtension")=$GET(SDDATA(44,SDCLNIEN_",",99.1,"E"))
+29 ;REQUIRE X-RAY FILMS?
SET SDCLNSREC("Clinic","ReqXrayFilms")=$GET(SDDATA(44,SDCLNIEN_",",2000,"E"))
+30 ;REQUIRE ACTION PROFILES?
SET SDCLNSREC("Clinic","ReqActionProfiles")=$GET(SDDATA(44,SDCLNIEN_",",2000.5,"E"))
+31 ;NO SHOW LETTER
SET SDCLNSREC("Clinic","NoShowLetter")=$GET(SDDATA(44,SDCLNIEN_",",2508,"E"))
+32 ;NO SHOW IEN
SET SDCLNSREC("Clinic","NoShowLetterIEN")=$GET(SDDATA(44,SDCLNIEN_",",2508,"I"))
+33 ;PRE-APPOINTMENT LETTER
SET SDCLNSREC("Clinic","PreApptLetter")=$GET(SDDATA(44,SDCLNIEN_",",2509,"E"))
+34 ;CLINIC CANCELLATION LETTER
SET SDCLNSREC("Clinic","CancelLetter")=$GET(SDDATA(44,SDCLNIEN_",",2510,"E"))
+35 ;APPT. CANCELLATION LETTER
SET SDCLNSREC("Clinic","ApptCancelLetter")=$GET(SDDATA(44,SDCLNIEN_",",2511,"E"))
+36 ;ASK FOR CHECK IN/OUT TIME
SET SDCLNSREC("Clinic","CheckinCheckoutTime")=$GET(SDDATA(44,SDCLNIEN_",",24,"E"))
+37 ;DEFAULT TO PC PRACTITIONER?
SET SDCLNSREC("Clinic","DefaultToPCPractitioner")=$GET(SDDATA(44,SDCLNIEN_",",2801,"E"))
+38 ;WORKLOAD VALIDATION AT CHK OUT
SET SDCLNSREC("Clinic","WorkloadValidationCheckout")=$GET(SDDATA(44,SDCLNIEN_",",30,"E"))
+39 ;ALLOWABLE CONSECUTIVE NO-SHOWS
SET SDCLNSREC("Clinic","AllowableConsecutiveNoShows")=$GET(SDDATA(44,SDCLNIEN_",",2001,"E"))
+40 ;MAX # DAYS FOR FUTURE BOOKING
SET SDCLNSREC("Clinic","MaxDaysForFutureBooking")=$GET(SDDATA(44,SDCLNIEN_",",2002,"E"))
+41 ;SCHEDULE ON HOLIDAYS?
SET SDCLNSREC("Clinic","HolidaySchedule")=$GET(SDDATA(44,SDCLNIEN_",",1918.5,"E"))
+42 ;CREDIT STOP IEN
SET SDCLNSREC("Clinic","CreditStopCodeNum")=$GET(SDDATA(44,SDCLNIEN_",",2503,"I"))
+43 ;CREDIT STOP NAME
SET SDCLNSREC("Clinic","CreditStopCodeName")=$GET(SDDATA(44,SDCLNIEN_",",2503,"E"))
+44 ;Credit Stop Code AMIS Number
SET SDCLNSREC("Clinic","CreditStopCodeAMISNum")=$$GET1^DIQ(40.7,$GET(SDDATA(44,SDCLNIEN_",",2503,"I")),1)
+45 ;PROHIBIT ACCESS TO CLINIC?
SET SDCLNSREC("Clinic","ProhibitAccessToClinic")=$GET(SDDATA(44,SDCLNIEN_",",2500,"E"))
+46 ;PHYSICAL LOCATION
SET SDCLNSREC("Clinic","PhysicalLocation")=$GET(SDDATA(44,SDCLNIEN_",",10,"E"))
+47 ;PRINCIPAL Clinic
SET SDCLNSREC("Clinic","Principal")=$GET(SDDATA(44,SDCLNIEN_",",1916,"E"))
+48 ;OVERBOOKS/DAY MAXIMUM
SET SDCLNSREC("Clinic","OverbooksPerDayMax")=$GET(SDDATA(44,SDCLNIEN_",",1918,"E"))
+49 ;E-CHECKIN ALLOWED
SET SDCLNSREC("Clinic","ECheckinAllowed")=$GET(SDDATA(44,SDCLNIEN_",",20,"E"))
+50 ;PRE-CHECKIN ALLOWED NO
SET SDCLNSREC("Clinic","PreCheckinAllowed")=$GET(SDDATA(44,SDCLNIEN_",",21,"E"))
+51 ;LENGTH OF APP'T
SET SDCLNSREC("Clinic","LengthOfAppt")=$GET(SDDATA(44,SDCLNIEN_",",1912,"E"))
+52 ;VARIABLE APP'NTMENT LENGTH
SET SDCLNSREC("Clinic","VariableApptLength")=$GET(SDDATA(44,SDCLNIEN_",",1913,"E"))
+53 ;DISPLAY INCREMENTS PER HOUR
SET SDCLNSREC("Clinic","IncrementsPerHr")=$GET(SDDATA(44,SDCLNIEN_",",1917,"E"))
+54 ; HOUR CLINIC DISPLAY BEGINS
SET SDCLNSREC("Clinic","HourClinicDisplayBegins")=$SELECT($GET(SDDATA(44,SDCLNIEN_",",1914,"E"))'="":$GET(SDDATA(44,SDCLNIEN_",",1914,"E")),1:8)
+55 SET SDTIMEZONE=$$TIMEZONEDATA^SDESUTIL($GET(SDCLNIEN))
SET SDTIMEZONEEXC=$PIECE($GET(SDTIMEZONE),U,3)
SET SDTIMEZONE=$PIECE($GET(SDTIMEZONE),U)
+56 SET SDCLNSREC("Clinic","Timezone")=SDTIMEZONE
+57 SET SDCLNSREC("Clinic","TimezoneException")=SDTIMEZONEEXC
+58 ;Inactivate Date
SET SDCLNSREC("Clinic","Inactivate Date")=$$FMTISO^SDAMUTDT($GET(SDDATA(44,SDCLNIEN_",",2505,"I")))
+59 ;Reactivate Date
SET SDCLNSREC("Clinic","Reactivate Date")=$$FMTISO^SDAMUTDT($GET(SDDATA(44,SDCLNIEN_",",2506,"I")))
+60 ; Get CHAR4 Data
+61 NEW CHAR4
+62 SET CHAR4=$$CHAR4^SDESUTIL($GET(SDDATA(44,SDCLNIEN_",",.01,"E")))
+63 SET SDCLNSREC("Clinic","CHAR4")=CHAR4
+64 ; Special Instructions Multiple
+65 SET SDX=""
SET SDC=0
+66 SET SDFIELDS="1910*"
+67 KILL SDDATA,SDMSG
+68 DO GETS^DIQ(44,SDCLNIEN_",",SDFIELDS,"E","SDDATA","SDMSG")
+69 FOR
SET SDX=$ORDER(SDDATA(44.03,SDX))
if SDX=""
QUIT
Begin DoDot:1
+70 SET SDC=SDC+1
+71 SET SDCLNSREC("Clinic","Special Instructions",SDC)=$GET(SDDATA(44.03,SDX,.01,"E"))
End DoDot:1
+72 ; Providers Multiple
+73 SET SDX=""
SET SDC=0
+74 SET SDFIELDS="2600*"
+75 KILL SDDATA,SDMSG
+76 DO GETS^DIQ(44,SDCLNIEN_",",SDFIELDS,"E","SDDATA","SDMSG")
+77 FOR
SET SDX=$ORDER(SDDATA(44.1,SDX))
if SDX=""
QUIT
Begin DoDot:1
+78 SET SDC=SDC+1
+79 SET SDCLNSREC("Clinic","Provider",SDC,"Name")=$GET(SDDATA(44.1,SDX,.01,"E"))
+80 SET SDCLNSREC("Clinic","Provider",SDC,"DefaultForClinic")=$GET(SDDATA(44.1,SDX,.02,"E"))
End DoDot:1
+81 ; Diagnosis Multiple
+82 SET SDX=""
SET SDC=0
+83 SET SDFIELDS="2700*"
+84 KILL SDDATA,SDMSG
+85 DO GETS^DIQ(44,SDCLNIEN_",",SDFIELDS,"E","SDDATA","SDMSG")
+86 FOR
SET SDX=$ORDER(SDDATA(44.11,SDX))
if SDX=""
QUIT
Begin DoDot:1
+87 SET SDC=SDC+1
+88 SET SDCLNSREC("Clinic","Diagnosis",SDC,"Code")=$GET(SDDATA(44.11,SDX,.01,"E"))
+89 SET SDCLNSREC("Clinic","Diagnosis",SDC,"DefaultForClinic")=$GET(SDDATA(44.11,SDX,.02,"E"))
End DoDot:1
+90 ; Return all Privileged Users
+91 SET (SDUSRCNT,SDUSRIEN)=0
+92 FOR
SET SDUSRIEN=$ORDER(^SC(SDCLNIEN,"SDPRIV",SDUSRIEN))
if 'SDUSRIEN
QUIT
Begin DoDot:1
+93 SET SDUSRCNT=SDUSRCNT+1
+94 SET SDCLNSREC("Clinic","PrivilegedUser",SDUSRCNT,"IEN")=SDUSRIEN
+95 SET SDCLNSREC("Clinic","PrivilegedUser",SDUSRCNT,"Name")=$$GET1^DIQ(44.04,SDUSRIEN_","_SDCLNIEN,.01)
End DoDot:1
+96 ;I USRCNT=0 S SDCLNSREC("Clinic","PrivilegedUser","Error",1)="No privileged users are found."
+97 ;
+98 IF $DATA(SDCLNSREC("Clinic"))
QUIT 1
+99 SET SDCLNSREC("Clinic")=""
+100 QUIT 0
+101 ;
UPDATECLINICHASH(SDCLIN,SDHASH,SDHASHDATE,SDCLNJSON) ;update clinic with new hash
+1 NEW SDFDA,SDFDAERR
+2 SET SDHASH=$$SHAN^XLFSHAN(160,SDCLNJSON(1))
+3 SET SDHASHDATE=$$NOW^XLFDT
+4 SET SDFDA(44,SDCLIN_",",2900)=SDHASH
+5 SET SDFDA(44,SDCLIN_",",2901)=SDHASHDATE
+6 DO FILE^DIE(,"SDFDA","FDAERR")
KILL FDA
+7 QUIT
+8 ;
ADDRESOURCE(SDCLINICIEN) ; NEED IEN TO FILE RESOURCE ?
+1 NEW SDABBR,SDDATA,SDDI,SDFDA,SDFOUND,SDI,SDNOD,SDRT,SDFIELDS
+2 SET SDFOUND=0
+3 SET SDI=""
FOR
SET SDI=$ORDER(^SDEC(409.831,"ALOC",SDCLINICIEN,SDI))
if SDI=""
QUIT
Begin DoDot:1
+4 SET SDNOD=$GET(^SDEC(409.831,SDI,0))
+5 SET SDRT=$PIECE(SDNOD,U,11)
+6 IF $PIECE(SDRT,";",2)="SC("
IF $PIECE(SDRT,";",1)=SDCLINICIEN
SET SDFOUND=1
End DoDot:1
if SDFOUND=1
QUIT
+7 SET SDI=$SELECT(SDFOUND=1:SDI,1:"+1")
+8 ;alb/sat 658 - add field 1
SET SDFIELDS=".01;1;1917"
+9 DO GETS^DIQ(44,SDCLINICIEN_",",SDFIELDS,"IE","SDDATA")
+10 SET SDFDA(409.831,SDI_",",.01)=SDDATA(44,SDCLINICIEN_",",.01,"E")
+11 SET SDDI=SDDATA(44,SDCLINICIEN_",",1917,"E")
SET SDFDA(409.831,SDI_",",.03)=$EXTRACT(SDDI,1,2)
+12 ;alb/sat 658 - add abbreviation
SET SDABBR=SDDATA(44,SDCLINICIEN_",",1,"E")
if SDABBR'=""
SET SDFDA(409.831,SDI_",",.011)=SDABBR
+13 SET SDFDA(409.831,SDI_",",.04)=SDCLINICIEN
+14 SET SDFDA(409.831,SDI_",",.012)=SDCLINICIEN_";SC("
+15 SET SDFDA(409.831,SDI_",",.015)=$EXTRACT($$NOW^XLFDT,1,12)
+16 SET SDFDA(409.831,SDI_",",.016)=DUZ
+17 DO UPDATE^DIE("","SDFDA")
+18 QUIT
+19 ;
DEFPROV(CLINIEN) ;
+1 NEW DPROV
+2 SET DPROV=$ORDER(^SC("ADPR",CLINIEN,0))
if 'DPROV
QUIT 0
+3 QUIT $$GET1^DIQ(44.1,DPROV_","_CLINIEN_",",.01,"I")
+4 ;
DEFDIAG(CLINIEN) ;
+1 NEW DDIAG
+2 SET DDIAG=$ORDER(^SC("ADDX",CLINIEN,0))
if 'DDIAG
QUIT 0
+3 QUIT $$GET1^DIQ(44.11,DDIAG_","_CLINIEN_",",.01,"I")
