Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDES2CLINUT

SDES2CLINUT.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. Q
  1. SAVEPROVIDERS(ERRORS,SDCLINIC,SDIEN) ;
  1. N PROVIEN,ACTION,DELIEN,CURDEFPROV,DEFPROVIEN,FDA,NEWDEFIEN,FDA,SFIEN
  1. S PROVIEN=0 F S PROVIEN=$O(SDCLINIC("PROVIDER",PROVIEN)) Q:'PROVIEN D
  1. .S ACTION=$G(SDCLINIC("PROVIDER",PROVIEN))
  1. .; delete provider
  1. .I ACTION="@" D Q
  1. ..I '$D(^SC(SDIEN,"PR","B",PROVIEN)) Q
  1. ..S DELIEN=$O(^SC(SDIEN,"PR","B",PROVIEN,0)) Q:'DELIEN
  1. ..S FDA(44.1,DELIEN_","_SDIEN_",",.01)="@" D FILE^DIE(,"FDA") K FDA
  1. .; default provider
  1. .I $D(SDCLINIC("PROVIDER",PROVIEN,"DEFAULT")) D Q
  1. ..S CURDEFPROV=$$DEFPROV(SDIEN)
  1. ..; clear out current default provider
  1. ..I CURDEFPROV D
  1. ...S DEFPROVIEN=$O(^SC(SDIEN,"PR","B",CURDEFPROV,0))
  1. ...S FDA(44.1,DEFPROVIEN_","_SDIEN_",",.02)="" D FILE^DIE(,"FDA") K FDA
  1. ..; if the current provider exists, file it as default
  1. ..I $D(^SC(SDIEN,"PR","B",PROVIEN)) D Q
  1. ...S NEWDEFIEN=$O(^SC(SDIEN,"PR","B",PROVIEN,0))
  1. ...S FDA(44.1,NEWDEFIEN_","_SDIEN_",",.02)=1 D FILE^DIE(,"FDA") K FDA
  1. ..; if current provider is new, file it and set to default
  1. ..I '$D(^SC(SDIEN,"PR","B",PROVIEN)) D Q
  1. ...S FDA(44.1,"+1,"_SDIEN_",",.01)=PROVIEN
  1. ...S FDA(44.1,"+1,"_SDIEN_",",.02)=1
  1. ...D UPDATE^DIE(,"FDA") K FDA
  1. .; remove default provider flag if the provider is passed in without the default designation
  1. .I $D(^SC(SDIEN,"PR","B",PROVIEN)),'$D(SDCLINIC("PROVIDER",PROVIEN,"DEFAULT")) D Q
  1. ..S SFIEN=$O(^SC(SDIEN,"PR","B",PROVIEN,0))
  1. ..S FDA(44.1,SFIEN_","_SDIEN_",",.02)="" D FILE^DIE(,"FDA") Q
  1. .; all other providers
  1. .I $D(^SC(SDIEN,"PR","B",PROVIEN)) Q
  1. .S FDA(44.1,"+1,"_SDIEN_",",.01)=PROVIEN D UPDATE^DIE(,"FDA") K FDA
  1. Q
  1. SAVEDIAG(ERRORS,SDCLINIC,SDIEN) ;
  1. N DIAGCODE,ACTION,DIAGIEN,CURDEFDIAG,REMDIAGIEN,DEFDIAGIEN,FDA,DIAGSFIEN,SFIEN
  1. S CURDEFDIAG=$$DEFDIAG(SDIEN)
  1. S DIAGCODE="" F S DIAGCODE=$O(SDCLINIC("DIAGNOSIS",DIAGCODE)) Q:DIAGCODE="" D
  1. .S DIAGIEN=$$CODEN^ICDEX(DIAGCODE,80),DIAGIEN=+$P(DIAGIEN,U)
  1. .I DIAGIEN=-1 D ERRLOG^SDES2JSON(.ERRORS,85,DIAGCODE)
  1. .S ACTION=$G(SDCLINIC("DIAGNOSIS",DIAGCODE))
  1. .; delete diagnosis
  1. .I ACTION="@" D Q
  1. ..I '$D(^SC(SDIEN,"DX","B",DIAGIEN)) Q
  1. ..S REMDIAGIEN=$O(^SC(SDIEN,"DX","B",DIAGIEN,0)) Q:'REMDIAGIEN
  1. ..S FDA(44.11,REMDIAGIEN_","_SDIEN_",",.01)="@" D FILE^DIE(,"FDA") K FDA Q
  1. .; Default diagnosis
  1. .I $D(SDCLINIC("DIAGNOSIS",DIAGCODE,"DEFAULT")) D Q
  1. ..; remove the current default
  1. ..I CURDEFDIAG D
  1. ...S DEFDIAGIEN=$O(^SC(SDIEN,"DX","B",CURDEFDIAG,0)) Q:'DEFDIAGIEN
  1. ...S FDA(44.11,DEFDIAGIEN_","_SDIEN_",",.02)="" D FILE^DIE(,"FDA") K FDA
  1. ..; if the current diagnosis exists, set it to default
  1. ..I $D(^SC(SDIEN,"DX","B",DIAGIEN)) D Q
  1. ...S DIAGSFIEN=$O(^SC(SDIEN,"DX","B",DIAGIEN,0)) Q:'DIAGSFIEN
  1. ...S FDA(44.11,DIAGSFIEN_","_SDIEN_",",.02)=1 D FILE^DIE(,"FDA") K FDA
  1. ..; if this is a new diagnosis, add it as default
  1. ..I '$D(^SC(SDIEN,"DX","B",DIAGIEN)) D
  1. ...S FDA(44.11,"+1,"_SDIEN_",",.01)=DIAGIEN
  1. ...S FDA(44.11,"+1,"_SDIEN_",",.02)=1
  1. ...D UPDATE^DIE(,"FDA") K FDA
  1. .; remove default diagnosis flag if the diagnosis is passed in without the default designation
  1. .I $D(^SC(SDIEN,"DX","B",DIAGIEN)),'$D(SDCLINIC("DIAGNOSIS",DIAGCODE,"DEFAULT")) D Q
  1. ..S SFIEN=$O(^SC(SDIEN,"DX","B",DIAGIEN,0))
  1. ..S FDA(44.11,SFIEN_","_SDIEN_",",.02)="" D FILE^DIE(,"FDA") K FDA
  1. .; All other diagnosis codes
  1. .I $D(^SC(SDIEN,"DX","B",DIAGIEN)) Q
  1. .S FDA(44.11,"+1,"_SDIEN_",",.01)=DIAGIEN D UPDATE^DIE(,"FDA") K FDA
  1. Q
  1. ; CLINDATA("SPECIAL INSTRUCTION",COUNTER)=IEN|TEXT - to edit existing entry
  1. ; CLINDATA("SPECIAL INSTRUCTION",COUNTER)=IEN|@ for deletion
  1. ; CLINDATA("SPECIAL INSTRUCTION",COUNTER)=""|TEXT to add new entry
  1. ;
  1. SAVEINSTRUCT(ERRORS,CLINDATA,SDIEN) ;
  1. N INSTRUCT,INSTDATA,INSLOOP,FDA,INSTTEXT,INSTIEN,FILERR
  1. S INSTRUCT=0 F S INSTRUCT=$O(CLINDATA("SPECIAL INSTRUCTIONS",INSTRUCT)) Q:'INSTRUCT D
  1. .S INSTDATA=$G(CLINDATA("SPECIAL INSTRUCTIONS",INSTRUCT))
  1. .S INSTIEN=$P(INSTDATA,"|")
  1. .S INSTTEXT=$P(INSTDATA,"|",2,99)
  1. .I INSTTEXT="@" D Q
  1. ..; cannot delete an entry that does not exist
  1. ..I '$D(^SC(SDIEN,"SI",INSTIEN)) Q
  1. ..S FDA(44.03,INSTIEN_","_SDIEN_",",.01)="@" D FILE^DIE(,"FDA") K FDA
  1. .I INSTIEN,INSTTEXT'="@" D Q
  1. ..I '$D(^SC(SDIEN,"SI",INSTIEN)) S FDA(44.03,"+1,"_SDIEN_",",.01)=INSTTEXT D UPDATE^DIE(,"FDA") K FDA Q
  1. ..S FDA(44.03,INSTIEN_","_SDIEN_",",.01)=INSTTEXT D FILE^DIE(,"FDA","FILERR") K FDA
  1. .I 'INSTIEN S FDA(44.03,"+1,"_SDIEN_",",.01)=INSTTEXT D UPDATE^DIE(,"FDA") K FDA
  1. Q
  1. SAVEPRIVUSERS(ERRORS,CLINDATA,SDIEN) ;
  1. N PUSER,USERACT,NEWIEN
  1. S PUSER=0 F S PUSER=$O(CLINDATA("PRIVILEGED USER",PUSER)) Q:'PUSER D
  1. .S USERACT=$G(CLINDATA("PRIVILEGED USER",PUSER))
  1. .I USERACT="@" S FDA(44.04,PUSER_","_SDIEN_",",.01)="@" D FILE^DIE(,"FDA") K FDA Q
  1. .S FDA(44.04,"+1,"_SDIEN_",",.01)=PUSER
  1. .S NEWIEN(1)=PUSER
  1. .D UPDATE^DIE(,"FDA","NEWIEN") K FDA
  1. Q
  1. ;
  1. SAVESUBSPEC(ERRORS,CLINDATA,SDIEN) ; Save subspecialties from file #409.94
  1. N SSFDA,SUBSPECCNT,SUBSPECDAT,SUBSPECFN
  1. S SUBSPECCNT=0
  1. F S SUBSPECCNT=$O(CLINDATA("SUBSPECIALTY",SUBSPECCNT)) Q:'SUBSPECCNT D
  1. . S SUBSPECDAT=CLINDATA("SUBSPECIALTY",SUBSPECCNT)
  1. . S SUBSPECFN=$S($P(SUBSPECDAT,"^",2)="T":44.0302,1:44.0301)
  1. . S SSFDA(SUBSPECFN,"+1,"_SDIEN_",",.01)=$P(SUBSPECDAT,"^")
  1. . D UPDATE^DIE(,"SSFDA") K SSFDA
  1. Q
  1. ;
  1. DELSUBSPEC(SDIEN) ; Clear out the Subspecialty sub-files before repopulating
  1. N SSFDA,SSFN,SSIEN,SSMULT
  1. F SSMULT=301:1:302 D
  1. . S SSIEN=0,SSFN=$S(SSMULT=301:44.0301,1:44.0302)
  1. . F S SSIEN=$O(^SC(SDIEN,SSMULT,SSIEN)) Q:'SSIEN D
  1. . . S SSFDA(SSFN,SSIEN_","_SDIEN_",",.01)="@"
  1. . . D FILE^DIE(,"SSFDA") K SSFDA
  1. Q
  1. ;
  1. ADDHASH2CLIN(SDCLINICIEN) ; add HASH to clinic after creation of clinic
  1. N SDHASH,SDHASHDATE,SDCLNJSON,SDCLNSREC
  1. D BLDCLNREC(.SDCLNSREC,SDCLINICIEN)
  1. D BUILDJSON^SDES2JSON(.SDCLNJSON,.SDCLNSREC)
  1. D UPDATECLINICHASH(SDCLINICIEN,.SDHASH,.SDHASHDATE,.SDCLNJSON)
  1. Q
  1. ;
  1. BLDCLNREC(SDCLNSREC,SDCLNIEN) ;Get Clinic data
  1. ;
  1. N SDFIELDS,SDDATA,SDMSG,SDX,SDC,SDTIMEZONE,SDTIMEZONEEXC,SDUSRCNT,SDUSRIEN,SDSTATUSINACTIVE,SDSTATUS,SDECI
  1. S SDECI=$G(SDECI,0)
  1. 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"
  1. D GETS^DIQ(44,SDCLNIEN_",",SDFIELDS,"IE","SDDATA","SDMSG")
  1. S SDECI=SDECI+1
  1. S SDCLNSREC("Clinic","ClinicIEN")=$G(SDCLNIEN) ;Clinic IEN
  1. S SDCLNSREC("Clinic","ClinicName")=$G(SDDATA(44,SDCLNIEN_",",.01,"E")) ;Clinic Name
  1. S SDCLNSREC("Clinic","Abbreviation")=$G(SDDATA(44,SDCLNIEN_",",1,"E")) ;Clinic Abbreviation
  1. S SDCLNSREC("Clinic","PatientFriendlyName")=$G(SDDATA(44,SDCLNIEN_",",60,"E")) ;Patient Friendly Name
  1. S SDCLNSREC("Clinic","StationNumber")=$$STATIONNUMBER^SDESUTIL(SDCLNIEN) ;Clinic station number
  1. S SDCLNSREC("Clinic","MeetsAtThisFacility")=$G(SDDATA(44,SDCLNIEN_",",2504,"E")) ;Clinic meets at this facility?
  1. S SDCLNSREC("Clinic","AllowPatScheduling")=$G(SDDATA(44,SDCLNIEN_",",61,"E")) ;Allow Direct Patient Scheduling?
  1. S SDCLNSREC("Clinic","DisplayClinicAppt")=$G(SDDATA(44,SDCLNIEN_",",62,"E")) ;DISPLAY CLIN APPT TO PATIENTS?
  1. S SDCLNSREC("Clinic","VeteranSelfCancel")=$G(SDDATA(44,SDCLNIEN_",",63,"E")) ;VETERAN SELF-CANCEL
  1. S SDCLNSREC("Clinic","Service")=$G(SDDATA(44,SDCLNIEN_",",9,"E")) ;Service
  1. S SDCLNSREC("Clinic","NonCountClinic")=$G(SDDATA(44,SDCLNIEN_",",2502,"E")) ;NON-COUNT CLINIC? (Y OR N)
  1. S SDCLNSREC("Clinic","DivisionIEN")=$G(SDDATA(44,SDCLNIEN_",",3.5,"I")) ;Division
  1. S SDCLNSREC("Clinic","DivisionName")=$G(SDDATA(44,SDCLNIEN_",",3.5,"E")) ;Division
  1. S SDSTATUS=$$INACTIVE^SDESUTIL(SDCLNIEN,DT),SDSTATUS=$S(SDSTATUS=0:"ACTIVE",1:"INACTIVE") ;Get status of clinic
  1. S SDCLNSREC("Clinic","ClinicStatus")=SDSTATUS
  1. S SDCLNSREC("Clinic","StopCodeName")=$G(SDDATA(44,SDCLNIEN_",",8,"E")) ;Stop Code Name
  1. S SDCLNSREC("Clinic","StopCodeNum")=$G(SDDATA(44,SDCLNIEN_",",8,"I")) ;Stop Code IEN
  1. S SDCLNSREC("Clinic","StopCodeAMISNum")=$$GET1^DIQ(40.7,$G(SDDATA(44,SDCLNIEN_",",8,"I")),1) ;Stop Code AMIS Number
  1. S SDCLNSREC("Clinic","DefaultApptType")=$G(SDDATA(44,SDCLNIEN_",",2507,"E")) ;Default Appointment type
  1. S SDCLNSREC("Clinic","AdminInpatientMeds")=$G(SDDATA(44,SDCLNIEN_",",2802,"E")) ;ADMINISTER INPATIENT MEDS?
  1. S SDCLNSREC("Clinic","Telephone")=$G(SDDATA(44,SDCLNIEN_",",99,"E")) ;TELEPHONE
  1. S SDCLNSREC("Clinic","TelephoneExtension")=$G(SDDATA(44,SDCLNIEN_",",99.1,"E")) ;TELEPHONE Extension
  1. S SDCLNSREC("Clinic","ReqXrayFilms")=$G(SDDATA(44,SDCLNIEN_",",2000,"E")) ;REQUIRE X-RAY FILMS?
  1. S SDCLNSREC("Clinic","ReqActionProfiles")=$G(SDDATA(44,SDCLNIEN_",",2000.5,"E")) ;REQUIRE ACTION PROFILES?
  1. S SDCLNSREC("Clinic","NoShowLetter")=$G(SDDATA(44,SDCLNIEN_",",2508,"E")) ;NO SHOW LETTER
  1. S SDCLNSREC("Clinic","NoShowLetterIEN")=$G(SDDATA(44,SDCLNIEN_",",2508,"I")) ;NO SHOW IEN
  1. S SDCLNSREC("Clinic","PreApptLetter")=$G(SDDATA(44,SDCLNIEN_",",2509,"E")) ;PRE-APPOINTMENT LETTER
  1. S SDCLNSREC("Clinic","CancelLetter")=$G(SDDATA(44,SDCLNIEN_",",2510,"E")) ;CLINIC CANCELLATION LETTER
  1. S SDCLNSREC("Clinic","ApptCancelLetter")=$G(SDDATA(44,SDCLNIEN_",",2511,"E")) ;APPT. CANCELLATION LETTER
  1. S SDCLNSREC("Clinic","CheckinCheckoutTime")=$G(SDDATA(44,SDCLNIEN_",",24,"E")) ;ASK FOR CHECK IN/OUT TIME
  1. S SDCLNSREC("Clinic","DefaultToPCPractitioner")=$G(SDDATA(44,SDCLNIEN_",",2801,"E")) ;DEFAULT TO PC PRACTITIONER?
  1. S SDCLNSREC("Clinic","WorkloadValidationCheckout")=$G(SDDATA(44,SDCLNIEN_",",30,"E")) ;WORKLOAD VALIDATION AT CHK OUT
  1. S SDCLNSREC("Clinic","AllowableConsecutiveNoShows")=$G(SDDATA(44,SDCLNIEN_",",2001,"E")) ;ALLOWABLE CONSECUTIVE NO-SHOWS
  1. S SDCLNSREC("Clinic","MaxDaysForFutureBooking")=$G(SDDATA(44,SDCLNIEN_",",2002,"E")) ;MAX # DAYS FOR FUTURE BOOKING
  1. S SDCLNSREC("Clinic","HolidaySchedule")=$G(SDDATA(44,SDCLNIEN_",",1918.5,"E")) ;SCHEDULE ON HOLIDAYS?
  1. S SDCLNSREC("Clinic","CreditStopCodeNum")=$G(SDDATA(44,SDCLNIEN_",",2503,"I")) ;CREDIT STOP IEN
  1. S SDCLNSREC("Clinic","CreditStopCodeName")=$G(SDDATA(44,SDCLNIEN_",",2503,"E")) ;CREDIT STOP NAME
  1. S SDCLNSREC("Clinic","CreditStopCodeAMISNum")=$$GET1^DIQ(40.7,$G(SDDATA(44,SDCLNIEN_",",2503,"I")),1) ;Credit Stop Code AMIS Number
  1. S SDCLNSREC("Clinic","ProhibitAccessToClinic")=$G(SDDATA(44,SDCLNIEN_",",2500,"E")) ;PROHIBIT ACCESS TO CLINIC?
  1. S SDCLNSREC("Clinic","PhysicalLocation")=$G(SDDATA(44,SDCLNIEN_",",10,"E")) ;PHYSICAL LOCATION
  1. S SDCLNSREC("Clinic","Principal")=$G(SDDATA(44,SDCLNIEN_",",1916,"E")) ;PRINCIPAL Clinic
  1. S SDCLNSREC("Clinic","OverbooksPerDayMax")=$G(SDDATA(44,SDCLNIEN_",",1918,"E")) ;OVERBOOKS/DAY MAXIMUM
  1. S SDCLNSREC("Clinic","ECheckinAllowed")=$G(SDDATA(44,SDCLNIEN_",",20,"E")) ;E-CHECKIN ALLOWED
  1. S SDCLNSREC("Clinic","PreCheckinAllowed")=$G(SDDATA(44,SDCLNIEN_",",21,"E")) ;PRE-CHECKIN ALLOWED NO
  1. S SDCLNSREC("Clinic","LengthOfAppt")=$G(SDDATA(44,SDCLNIEN_",",1912,"E")) ;LENGTH OF APP'T
  1. S SDCLNSREC("Clinic","VariableApptLength")=$G(SDDATA(44,SDCLNIEN_",",1913,"E")) ;VARIABLE APP'NTMENT LENGTH
  1. S SDCLNSREC("Clinic","IncrementsPerHr")=$G(SDDATA(44,SDCLNIEN_",",1917,"E")) ;DISPLAY INCREMENTS PER HOUR
  1. S SDCLNSREC("Clinic","HourClinicDisplayBegins")=$S($G(SDDATA(44,SDCLNIEN_",",1914,"E"))'="":$G(SDDATA(44,SDCLNIEN_",",1914,"E")),1:8) ; HOUR CLINIC DISPLAY BEGINS
  1. S SDTIMEZONE=$$TIMEZONEDATA^SDESUTIL($G(SDCLNIEN)),SDTIMEZONEEXC=$P($G(SDTIMEZONE),U,3),SDTIMEZONE=$P($G(SDTIMEZONE),U)
  1. S SDCLNSREC("Clinic","Timezone")=SDTIMEZONE
  1. S SDCLNSREC("Clinic","TimezoneException")=SDTIMEZONEEXC
  1. S SDCLNSREC("Clinic","Inactivate Date")=$$FMTISO^SDAMUTDT($G(SDDATA(44,SDCLNIEN_",",2505,"I"))) ;Inactivate Date
  1. S SDCLNSREC("Clinic","Reactivate Date")=$$FMTISO^SDAMUTDT($G(SDDATA(44,SDCLNIEN_",",2506,"I"))) ;Reactivate Date
  1. ; Get CHAR4 Data
  1. N CHAR4
  1. S CHAR4=$$CHAR4^SDESUTIL($G(SDDATA(44,SDCLNIEN_",",.01,"E")))
  1. S SDCLNSREC("Clinic","CHAR4")=CHAR4
  1. ; Special Instructions Multiple
  1. S SDX="",SDC=0
  1. S SDFIELDS="1910*"
  1. K SDDATA,SDMSG
  1. D GETS^DIQ(44,SDCLNIEN_",",SDFIELDS,"E","SDDATA","SDMSG")
  1. F S SDX=$O(SDDATA(44.03,SDX)) Q:SDX="" D
  1. .S SDC=SDC+1
  1. .S SDCLNSREC("Clinic","Special Instructions",SDC)=$G(SDDATA(44.03,SDX,.01,"E"))
  1. ; Providers Multiple
  1. S SDX="",SDC=0
  1. S SDFIELDS="2600*"
  1. K SDDATA,SDMSG
  1. D GETS^DIQ(44,SDCLNIEN_",",SDFIELDS,"E","SDDATA","SDMSG")
  1. F S SDX=$O(SDDATA(44.1,SDX)) Q:SDX="" D
  1. .S SDC=SDC+1
  1. .S SDCLNSREC("Clinic","Provider",SDC,"Name")=$G(SDDATA(44.1,SDX,.01,"E"))
  1. .S SDCLNSREC("Clinic","Provider",SDC,"DefaultForClinic")=$G(SDDATA(44.1,SDX,.02,"E"))
  1. ; Diagnosis Multiple
  1. S SDX="",SDC=0
  1. S SDFIELDS="2700*"
  1. K SDDATA,SDMSG
  1. D GETS^DIQ(44,SDCLNIEN_",",SDFIELDS,"E","SDDATA","SDMSG")
  1. F S SDX=$O(SDDATA(44.11,SDX)) Q:SDX="" D
  1. .S SDC=SDC+1
  1. .S SDCLNSREC("Clinic","Diagnosis",SDC,"Code")=$G(SDDATA(44.11,SDX,.01,"E"))
  1. .S SDCLNSREC("Clinic","Diagnosis",SDC,"DefaultForClinic")=$G(SDDATA(44.11,SDX,.02,"E"))
  1. ; Return all Privileged Users
  1. S (SDUSRCNT,SDUSRIEN)=0
  1. F S SDUSRIEN=$O(^SC(SDCLNIEN,"SDPRIV",SDUSRIEN)) Q:'SDUSRIEN D
  1. .S SDUSRCNT=SDUSRCNT+1
  1. .S SDCLNSREC("Clinic","PrivilegedUser",SDUSRCNT,"IEN")=SDUSRIEN
  1. .S SDCLNSREC("Clinic","PrivilegedUser",SDUSRCNT,"Name")=$$GET1^DIQ(44.04,SDUSRIEN_","_SDCLNIEN,.01)
  1. ;I USRCNT=0 S SDCLNSREC("Clinic","PrivilegedUser","Error",1)="No privileged users are found."
  1. ;
  1. I $D(SDCLNSREC("Clinic")) Q 1
  1. S SDCLNSREC("Clinic")=""
  1. Q 0
  1. ;
  1. UPDATECLINICHASH(SDCLIN,SDHASH,SDHASHDATE,SDCLNJSON) ;update clinic with new hash
  1. N SDFDA,SDFDAERR
  1. S SDHASH=$$SHAN^XLFSHAN(160,SDCLNJSON(1))
  1. S SDHASHDATE=$$NOW^XLFDT
  1. S SDFDA(44,SDCLIN_",",2900)=SDHASH
  1. S SDFDA(44,SDCLIN_",",2901)=SDHASHDATE
  1. D FILE^DIE(,"SDFDA","FDAERR") K FDA
  1. Q
  1. ;
  1. ADDRESOURCE(SDCLINICIEN) ; NEED IEN TO FILE RESOURCE ?
  1. N SDABBR,SDDATA,SDDI,SDFDA,SDFOUND,SDI,SDNOD,SDRT,SDFIELDS
  1. S SDFOUND=0
  1. S SDI="" F S SDI=$O(^SDEC(409.831,"ALOC",SDCLINICIEN,SDI)) Q:SDI="" D Q:SDFOUND=1
  1. . S SDNOD=$G(^SDEC(409.831,SDI,0))
  1. . S SDRT=$P(SDNOD,U,11)
  1. . I $P(SDRT,";",2)="SC(",$P(SDRT,";",1)=SDCLINICIEN S SDFOUND=1
  1. S SDI=$S(SDFOUND=1:SDI,1:"+1")
  1. S SDFIELDS=".01;1;1917" ;alb/sat 658 - add field 1
  1. D GETS^DIQ(44,SDCLINICIEN_",",SDFIELDS,"IE","SDDATA")
  1. S SDFDA(409.831,SDI_",",.01)=SDDATA(44,SDCLINICIEN_",",.01,"E")
  1. S SDDI=SDDATA(44,SDCLINICIEN_",",1917,"E") S SDFDA(409.831,SDI_",",.03)=$E(SDDI,1,2)
  1. S SDABBR=SDDATA(44,SDCLINICIEN_",",1,"E") S:SDABBR'="" SDFDA(409.831,SDI_",",.011)=SDABBR ;alb/sat 658 - add abbreviation
  1. S SDFDA(409.831,SDI_",",.04)=SDCLINICIEN
  1. S SDFDA(409.831,SDI_",",.012)=SDCLINICIEN_";SC("
  1. S SDFDA(409.831,SDI_",",.015)=$E($$NOW^XLFDT,1,12)
  1. S SDFDA(409.831,SDI_",",.016)=DUZ
  1. D UPDATE^DIE("","SDFDA")
  1. Q
  1. ;
  1. DEFPROV(CLINIEN) ;
  1. N DPROV
  1. S DPROV=$O(^SC("ADPR",CLINIEN,0)) Q:'DPROV 0
  1. Q $$GET1^DIQ(44.1,DPROV_","_CLINIEN_",",.01,"I")
  1. ;
  1. DEFDIAG(CLINIEN) ;
  1. N DDIAG
  1. S DDIAG=$O(^SC("ADDX",CLINIEN,0)) Q:'DDIAG 0
  1. Q $$GET1^DIQ(44.11,DDIAG_","_CLINIEN_",",.01,"I")