- SDES2CLINUT ;ALB/BWF,JAS - SDES2 Clinic Save utilities ;NOV 06, 2024
- ;;5.3;Scheduling;**853,857,866,885,895**;Aug 13, 1993;Build 11
- ;;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
- ;
- SAVESUBSPEC(ERRORS,CLINDATA,SDIEN) ; Save subspecialties from file #409.94
- N SSFDA,SUBSPECCNT,SUBSPECDAT,SUBSPECFN
- S SUBSPECCNT=0
- F S SUBSPECCNT=$O(CLINDATA("SUBSPECIALTY",SUBSPECCNT)) Q:'SUBSPECCNT D
- . S SUBSPECDAT=CLINDATA("SUBSPECIALTY",SUBSPECCNT)
- . S SUBSPECFN=$S($P(SUBSPECDAT,"^",2)="T":44.0302,1:44.0301)
- . S SSFDA(SUBSPECFN,"+1,"_SDIEN_",",.01)=$P(SUBSPECDAT,"^")
- . D UPDATE^DIE(,"SSFDA") K SSFDA
- Q
- ;
- DELSUBSPEC(SDIEN) ; Clear out the Subspecialty sub-files before repopulating
- N SSFDA,SSFN,SSIEN,SSMULT
- F SSMULT=301:1:302 D
- . S SSIEN=0,SSFN=$S(SSMULT=301:44.0301,1:44.0302)
- . F S SSIEN=$O(^SC(SDIEN,SSMULT,SSIEN)) Q:'SSIEN D
- . . S SSFDA(SSFN,SSIEN_","_SDIEN_",",.01)="@"
- . . D FILE^DIE(,"SSFDA") K SSFDA
- 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 15032 printed Feb 19, 2025@00:19:59 Page 2
- SDES2CLINUT ;ALB/BWF,JAS - SDES2 Clinic Save utilities ;NOV 06, 2024
- +1 ;;5.3;Scheduling;**853,857,866,885,895**;Aug 13, 1993;Build 11
- +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 ;
- SAVESUBSPEC(ERRORS,CLINDATA,SDIEN) ; Save subspecialties from file #409.94
- +1 NEW SSFDA,SUBSPECCNT,SUBSPECDAT,SUBSPECFN
- +2 SET SUBSPECCNT=0
- +3 FOR
- SET SUBSPECCNT=$ORDER(CLINDATA("SUBSPECIALTY",SUBSPECCNT))
- if 'SUBSPECCNT
- QUIT
- Begin DoDot:1
- +4 SET SUBSPECDAT=CLINDATA("SUBSPECIALTY",SUBSPECCNT)
- +5 SET SUBSPECFN=$SELECT($PIECE(SUBSPECDAT,"^",2)="T":44.0302,1:44.0301)
- +6 SET SSFDA(SUBSPECFN,"+1,"_SDIEN_",",.01)=$PIECE(SUBSPECDAT,"^")
- +7 DO UPDATE^DIE(,"SSFDA")
- KILL SSFDA
- End DoDot:1
- +8 QUIT
- +9 ;
- DELSUBSPEC(SDIEN) ; Clear out the Subspecialty sub-files before repopulating
- +1 NEW SSFDA,SSFN,SSIEN,SSMULT
- +2 FOR SSMULT=301:1:302
- Begin DoDot:1
- +3 SET SSIEN=0
- SET SSFN=$SELECT(SSMULT=301:44.0301,1:44.0302)
- +4 FOR
- SET SSIEN=$ORDER(^SC(SDIEN,SSMULT,SSIEN))
- if 'SSIEN
- QUIT
- Begin DoDot:2
- +5 SET SSFDA(SSFN,SSIEN_","_SDIEN_",",.01)="@"
- +6 DO FILE^DIE(,"SSFDA")
- KILL SSFDA
- End DoDot:2
- End DoDot:1
- +7 QUIT
- +8 ;
- 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")