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

SDES2UTIL.m

Go to the documentation of this file.
  1. SDES2UTIL ;ALB/MGD,ANU,TJB,BWF,MGD - SDES2 UTILITIES ;AUG 28, 2024
  1. ;;5.3;Scheduling;**853,857,864,877,887**;Aug 13, 1993;Build 7
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. ; Reference to INSTITUTION in #2251
  1. ; Reference to KERNEL SYSTEM PARAMETERS in #1518
  1. ; Reference to ^ECX(728.44 in #7340
  1. ; Reference to OWNREC^DGSEC4 in ICR #7036
  1. ; Reference to SENS^DGSEC4 in ICR #7036
  1. Q
  1. ;
  1. PADCLTIME(TIME) ;
  1. ; TIME - Time to Pad
  1. S TIME=$S($G(TIME)'="":TIME,1:8)
  1. I TIME'?1.2N Q -1
  1. S TIME=TIME_"00"
  1. Q TIME
  1. ;
  1. PADFMTIME(TIME) ;
  1. ; TIME - Time to Pad
  1. I TIME'?1.4N Q -1
  1. S TIME=$E(TIME_"0000",1,4)
  1. Q TIME
  1. ;
  1. PADLENGTH(STRING,CHAR,LENGTH,WHERE) ;
  1. N PAD,PADST
  1. I $L(STRING)'<LENGTH Q STRING
  1. S PADST=LENGTH-$L(STRING)
  1. S $P(PAD,CHAR,PADST)=CHAR
  1. I WHERE="F" S STRING=PAD_STRING
  1. I WHERE="E" S STRING=STRING_PAD
  1. Q STRING
  1. ;
  1. VALACHERONID(SDACHERONID) ;
  1. I SDACHERONID="" S SDACHERONID=-1 Q SDACHERONID
  1. S SDACHERONID=$$STRIP(SDACHERONID)
  1. I $L(SDACHERONID)>40 S SDACHERONID=-1
  1. Q SDACHERONID
  1. ;
  1. STRIP(SDECZ) ;Replace control characters with spaces
  1. N SDECI
  1. F SDECI=1:1:$L(SDECZ) I (32>$A($E(SDECZ,SDECI))) S SDECZ=$E(SDECZ,1,SDECI-1)_" "_$E(SDECZ,SDECI+1,999)
  1. Q SDECZ
  1. ;
  1. ISDATEDST(DATE,DSTSUM) ;Does this date use Daylight Savings
  1. ; DATE - FM format
  1. ; DSTSUM - "DST" or "SUM"
  1. ; Return 1 = DATE is considered DST or SUM
  1. ; 0 = DATE is not DST and not SUM
  1. ; -1 = DATE is not FM format
  1. N YR
  1. S DATE=$G(DATE),DSTSUM=$G(DSTSUM)
  1. I '$$VALIDFMFORMAT^SDECDATE(DATE) Q -1
  1. S YR=$E(DATE,2,3)
  1. I DATE<$$DSTSTART(YR,DSTSUM) Q 0
  1. I DATE>$$DSTEND(YR,DSTSUM) Q 0
  1. Q 1
  1. DSTSTART(YR,DSTSUM) ;Daylight Savings or Summer start date
  1. ; countries that observe DST or Summer ST (e.g., USA observes DST and Europe observes SUM ST)
  1. ; YR - 2 digit year
  1. ; DSTSUM - "DST" or "SUM"
  1. ; Return is the FM date for the FIRST day of DST or SUM
  1. N DSTMONTH,DOW,DSTDT,SUNDAY
  1. S DSTMONTH="0301",DSTSUM=$G(DSTSUM)
  1. ; SUNDAY will be 2nd Sunday in March OR Last Sunday in March
  1. S SUNDAY=$S(DSTSUM="DST":2,DSTSUM="SUM":"4,5",1:2) ;if not DST or SUM, treat as DST
  1. S YR=$G(YR)
  1. I YR="" S DSTDT=$E(DT,1,3)_DSTMONTH
  1. E S DSTDT=$E(DT)_YR_DSTMONTH
  1. S DOW=$$DOW^XLFDT(DSTDT,1)
  1. I DOW D
  1. .I DSTSUM="DST" S DSTDT=DSTDT+(SUNDAY*7)-DOW
  1. .E S DSTDT=$$SUMMER(DSTDT,DOW,SUNDAY)
  1. Q DSTDT
  1. DSTEND(YR,DSTSUM) ;Daylight Savings END date
  1. ; YR - 2 digit year
  1. ; DSTSUM - "DST" or "SUM"
  1. ; Return is the FM date for the LAST day of DST or SUM
  1. N DSTMONTH,DOW,DSTDT,SUNDAY
  1. S DSTSUM=$G(DSTSUM)
  1. S DSTMONTH=$S(DSTSUM="DST":"1101",DSTSUM="SUM":"1001",1:"1101")
  1. ; SUNDAY will be first Sunday in November or last Sunday in October
  1. S SUNDAY=$S(DSTSUM="DST":1,DSTSUM="SUM":"4,5",1:1) ; if not DST or SUM treat as DST
  1. S YR=$G(YR)
  1. I YR="" S DSTDT=$E(DT,1,3)_DSTMONTH
  1. E S DSTDT=$E(DT)_YR_DSTMONTH
  1. S DOW=$$DOW^XLFDT(DSTDT,1)
  1. I DOW D
  1. .I DSTSUM="DST" S DSTDT=DSTDT+(SUNDAY*7)-DOW
  1. .E S DSTDT=$$SUMMER(DSTDT,DOW,SUNDAY)
  1. Q $$FMADD^XLFDT(DSTDT,-1)
  1. ;
  1. SUMMER(DSTDT,DOW,SUNDAY) ; determine last Sunday of MARCH or OCTOBER
  1. ; DSTDT - March or October (e.g, CYY0301 or CYY1001)
  1. ; DOW - 1, 2, 3, 4, 5, or 6
  1. ; SUNDAY - "4,5" representing 4th or 5th Sunday of March or October
  1. ; Returns the date when SUMMER offset begins or ends (e.g., eastern Europe uses Summer offset)
  1. N X,VALIDSUNDAY,LASTSUNDAY
  1. S DSTDT=$G(DSTDT),DOW=$G(DOW),SUNDAY=$G(SUNDAY)
  1. S LASTSUNDAY=0
  1. F X=1,2 S VALIDSUNDAY=DSTDT+($P(SUNDAY,",",X)*7)-DOW I $$VALIDFMFORMAT^SDECDATE(VALIDSUNDAY) S LASTSUNDAY=VALIDSUNDAY
  1. Q LASTSUNDAY
  1. ;
  1. TIMEZONEDATA(CLINICIEN) ;Get timezone and offsets
  1. ; CLINIC - IEN from Hospital Location #44
  1. ; If clinic is not passed, use default Facility/Institution
  1. ; Output:
  1. ; Returns TimeZone Name ^ TimeZone IEN ^ TimeZone Exception ^ Offset for Standard Time ^ Offset for DST or SUMMER ^
  1. N SDINST,SDDIV,SDTIMEZONEE,SDTIMEZONEI,TIMEZONEEXECPT,X,POP,TIMEFRAMEARY,OFFSET,OFFSETDSTSUM,DSTSUM,RETURN,TIMEFRAMEIEN,SDMSG
  1. N EXECPTFLG
  1. S (POP,SDINST,DSTSUM,EXECPTFLG)="",(OFFSET,OFFSETDSTSUM)=-9999
  1. I $G(CLINICIEN) D
  1. .S SDDIV=$$GET1^DIQ(44,CLINICIEN_",",3.5,"I")
  1. .S:SDDIV SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I")
  1. ; 831 - BEGIN
  1. I $$GET1^DIQ(4,SDINST,800,"I")="" S SDINST=""
  1. ; 831 - END
  1. I SDINST="" S SDINST=$$GET1^DIQ(8989.3,1,217,"I")
  1. S SDTIMEZONEE=$$GET1^DIQ(4,SDINST,800,"E")
  1. S SDTIMEZONEI=$$GET1^DIQ(4,SDINST,800,"I")
  1. S EXECPTFLG=$$GET1^DIQ(4,SDINST,802,"I")
  1. S TIMEZONEEXECPT=$S(EXECPTFLG=0:1,1:0) ;if except value = 0 then exception is present
  1. ;
  1. F X=1:1:3 D Q:POP
  1. .S TIMEFRAMEIEN=X_","_SDTIMEZONEI_","
  1. .D GETS^DIQ(1.711,TIMEFRAMEIEN,".01;.02","IE","TIMEFRAMEARY","SDMSG") ;Data from WORLD TIMEZONE file
  1. .I '$D(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.01)) S POP=1 Q
  1. .I $G(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.01,"I"))="SST" S OFFSET=$G(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.02,"E"))
  1. .I $G(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.01,"I"))="DST" S DSTSUM="DST",OFFSETDSTSUM=$G(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.02,"E")) ;vse-2705
  1. .I $G(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.01,"I"))="SUM" S DSTSUM="SUM",OFFSETDSTSUM=$G(TIMEFRAMEARY(1.711,TIMEFRAMEIEN,.02,"E")) ;vse-2705
  1. ;
  1. Q SDTIMEZONEE_"^"_SDTIMEZONEI_"^"_TIMEZONEEXECPT_"^"_OFFSET_"^"_OFFSETDSTSUM_"^"_DSTSUM ;vse-2705
  1. ;
  1. GETTZOFFSET(SDDATE,SDCLINIC) ;Get Time Zone offset based on clinic and daylight savings
  1. ; SDCLINIC - OPT - IEN from Hospital Location #44
  1. ; SDDATE - REQ - FM formatted date
  1. ; Return
  1. ; If clinic is passed in get Division then Institution
  1. ; Otherwise get Institution from Kernel System Parameters
  1. ; Get the Time Zone and Time Zone Exception from the Institution
  1. N OFFSET,TZINFO
  1. S SDDATE=$G(SDDATE)
  1. I '$$VALIDFMFORMAT^SDECDATE(SDDATE) Q ""
  1. S SDCLINIC=$G(SDCLINIC)
  1. S TZINFO=$$TIMEZONEDATA(SDCLINIC)
  1. S OFFSET=$P(TZINFO,"^",4) ;assume non DST
  1. ; If the Institution uses DST or SUMMER & SDDATE is in the daylight savings period, then send the DST/SUMMER Offset
  1. I $P(TZINFO,"^",3)=0 S OFFSET=$S($$ISDATEDST(SDDATE,$P(TZINFO,"^",6)):$P(TZINFO,"^",5),1:OFFSET)
  1. Q OFFSET
  1. ;
  1. CHAR4(CLINNAME) ;
  1. ; CLINNAME - REQ - Name of clinic from #44
  1. ; Return
  1. ; The CODE (#.01) field from NATIONAL CLINIC (#728.411) file or null
  1. N IEN,NATLCODE
  1. I CLINNAME="" Q ""
  1. I '$D(^SC("B",CLINNAME)) Q ""
  1. S IEN=$$FIND1^DIC(728.44,"","X",CLINNAME)
  1. I 'IEN Q ""
  1. S NATLCODE=$$GET1^DIQ(728.44,IEN_",",7,"E")
  1. Q NATLCODE
  1. ;
  1. TELEPHONE(PHONE) ; Format all numeric Telephone Number
  1. ; PHONE - The Telephone Number
  1. ; Return
  1. ; If PHONE is all numeric it will be formatted as follows
  1. ; 1234567890 will be formatted as (123)456-7890
  1. ; otherwise the passed in PHONE is returned.
  1. S PHONE=$G(PHONE,"")
  1. I PHONE?10N S PHONE="("_$E(PHONE,1,3)_")"_$E(PHONE,4,6)_"-"_$E(PHONE,7,10)
  1. Q PHONE
  1. ;
  1. EXT(EXT) ; Add an x to the beginning of an all numeric Telephone Extension field.
  1. ; EXT - The Telephone Extension.
  1. ; Return
  1. ; If EXT is all numeric, a lowercase x concantenated to the passed in EXT.
  1. ; otherwise the passed in EXT is returned.
  1. S EXT=$G(EXT,"")
  1. I EXT?1.N S EXT="x"_EXT
  1. Q EXT
  1. ;
  1. INACTIVE(SDCL,SDDT) ; determine if clinic is active
  1. ; Input:
  1. ; SDCL = (Req) IEN of Clinic from file #44.
  1. ; SDDT = (Opt) Date to use for determining Status. If not passed in, defaults to DT.
  1. ; Return:
  1. ; 0=ACTIVE
  1. ; 1=INACTIVE
  1. N SDNODEI,INACTIVEDATE,REACTIVEDATE,STATUS
  1. S SDDT=$G(SDDT) I SDDT="" S SDDT=DT
  1. S SDDT=$P(SDDT,".",1)
  1. S STATUS=1
  1. S SDNODEI=$G(^SC(SDCL,"I"))
  1. I SDNODEI="" S STATUS=0 Q STATUS
  1. S INACTIVEDATE=$P(SDNODEI,U,1) ;inactive date/time
  1. S REACTIVEDATE=$P(SDNODEI,U,2) ;reactive date/time
  1. I (INACTIVEDATE="") S STATUS=0 Q STATUS
  1. I (REACTIVEDATE>=INACTIVEDATE)&(REACTIVEDATE<=SDDT) S STATUS=0 Q STATUS
  1. I INACTIVEDATE>SDDT S STATUS=0 Q STATUS
  1. Q STATUS
  1. ;
  1. STATIONNUMBER(CLINICIEN) ;
  1. ; Input:
  1. ; CLINICIEN (Opt) = IEN of the Clinic from File #44. If not passed in, the default
  1. ; Institution for the VistA Instance it used.
  1. ; Output: The STATION NUMBER (#99) field from the INSTITUTION (#4) file.
  1. N DIVISION,INSTIEN,STATIONNUMBER
  1. I $G(CLINICIEN)="" D Q STATIONNUMBER
  1. . S STATIONNUMBER=$$KSP^XUPARAM("INST")_","
  1. . S STATIONNUMBER=$$GET1^DIQ(4,STATIONNUMBER,99)
  1. I +$G(CLINICIEN) D Q STATIONNUMBER
  1. . S DIVISION=$$GET1^DIQ(44,CLINICIEN,3.5,"I")
  1. . S INSTIEN=$$GET1^DIQ(40.8,DIVISION,.07,"I")
  1. . S STATIONNUMBER=$$GET1^DIQ(4,INSTIEN,99,"I")
  1. Q
  1. ;
  1. VALIDATEAMIS(AMIS,RESTYP) ;
  1. ; Input:
  1. ; AMIS: The AMIS Stop Code to validate
  1. ; RESTYP: P:Primary, C:Credit
  1. ; Output:
  1. ; 0 = AMIS Stop Code is Valid
  1. ; # = Error number to log
  1. S AMIS=$G(AMIS),RESTYP=$G(RESTYP)
  1. N ERRORNUM
  1. S ERRORNUM=""
  1. I RESTYP="P" D PRIMARYAMIS(.AMIS,.ERRORNUM)
  1. I RESTYP="C" D SECONDARYAMIS(.AMIS,.ERRORNUM)
  1. Q +ERRORNUM
  1. ;
  1. PRIMARYAMIS(PRIAMIS,ERRORNUM) ;
  1. I +PRIAMIS=0 S ERRORNUM=270 Q
  1. I $L(PRIAMIS) D
  1. . I +PRIAMIS=0 S ERRORNUM=270 Q
  1. . I +PRIAMIS=900 S ERRORNUM=273 Q
  1. . S PRIAMIS=$$AMISTOSTOPCODE(.PRIAMIS)
  1. . I +PRIAMIS=0 S ERRORNUM=270 Q
  1. . I $$RESCHKFAILED(+PRIAMIS,"P") S ERRORNUM=287 Q
  1. . I $$STOPCODEINACTIVE(+PRIAMIS,"P") S ERRORNUM=512 Q
  1. Q
  1. ;
  1. SECONDARYAMIS(CREDITAMIS,ERRORNUM) ;
  1. I +CREDITAMIS=0 S ERRORNUM=271 Q
  1. I $L(CREDITAMIS) D
  1. . I +CREDITAMIS=0 S ERRORNUM=271 Q
  1. . I +CREDITAMIS=900 S ERRORNUM=273 Q
  1. . S CREDITAMIS=$$AMISTOSTOPCODE(.CREDITAMIS)
  1. . I +CREDITAMIS=0 S ERRORNUM=271 Q
  1. . I $$RESCHKFAILED(+CREDITAMIS,"S") S ERRORNUM=288 Q
  1. . I $$STOPCODEINACTIVE(+CREDITAMIS,"C") S ERRORNUM=513 Q
  1. Q
  1. ;
  1. AMISTOSTOPCODE(AMIS) ; Map from AMIS to Stop Code
  1. ; Input: AMIS = (Req) the AMIS REPORTING STOP CODE (#1) field from the CLINIC STOP (#40.7) file.
  1. ; Output: 0:validation failed, IEN for the Stop Code that matches to the passed in AMIS code.
  1. N STOPIEN,STOPINACTDT,STOPCOUNT,STOPFOUND
  1. I '$G(AMIS) Q 0
  1. S (STOPIEN,STOPCOUNT,STOPFOUND)=0
  1. F S STOPIEN=$O(^DIC(40.7,"C",AMIS,STOPIEN)) Q:'STOPIEN D
  1. .S STOPINACTDT=$$GET1^DIQ(40.7,STOPIEN,2,"I")
  1. .I STOPINACTDT,STOPINACTDT<DT!(STOPINACTDT=DT) Q
  1. .S STOPCOUNT=STOPCOUNT+1
  1. .S STOPFOUND=STOPIEN
  1. I STOPCOUNT>1 Q 0
  1. Q STOPFOUND
  1. ;
  1. STOPCODETOAMIS(STOPIEN) ; Map from Stop Code IEN to AMIS Stop Code Number
  1. ; Input: STOPIEN = (Req) The IEN of the Stop Code in the CLINIC STOP (#40.7) file.
  1. ; Output: "": validation failed, IEN for the AMIS REPORTING STOP CODE (#1).
  1. N STOPCODE
  1. S STOPCODE="",STOPIEN=$G(STOPIEN,"")
  1. Q:STOPIEN<1 STOPCODE
  1. Q:'$D(^DIC(40.7,STOPIEN,0)) STOPCODE
  1. S STOPCODE=$$GET1^DIQ(40.7,STOPIEN,1,"I")
  1. Q STOPCODE
  1. ;
  1. RESCHKFAILED(STOPCODEIEN,RESTYPE) ;
  1. ; Input: STOPCODEIEN (Req) IEN from CLINIC STOP (#40.7) file.
  1. ; RESTYPE (Req) P for Primary or S for Credit
  1. ; Output: 0: Restriction checks passed, 1: Restriction checks failed
  1. I '+STOPCODEIEN Q 1
  1. I "^P^S^"'[("^"_RESTYPE_"^") Q 1
  1. N RESTRICTION
  1. S RESTRICTION=$$GET1^DIQ(40.7,STOPCODEIEN,5,"I")
  1. I RESTRICTION="E" Q 0
  1. I RESTRICTION'=RESTYPE Q 1
  1. Q 0
  1. ;
  1. STOPCODEINACTIVE(SDAMISSTOPCODE,SDTYPE) ;
  1. ; SDAMISSTOPCODE = IEN of Stop Code
  1. N SDSTOPCODE,SDINACTIVEDATE
  1. S SDINACTIVEDATE=$$GET1^DIQ(40.7,SDAMISSTOPCODE,2,"I")
  1. I SDINACTIVEDATE="" Q 0
  1. I SDINACTIVEDATE>DT Q 0
  1. I SDTYPE="P" Q 512
  1. I SDTYPE="C" Q 513
  1. Q 0
  1. ; Set of codes internal to external
  1. SOCINT2EXT(FILE,FLD,INTVAL) ;
  1. N FOUND,ITEM,CODE,EXTCODE,RETURN,INTCODE,RESULTS
  1. I '$L($G(INTVAL)) Q ""
  1. S INTVAL=$$UP^XLFSTR(INTVAL)
  1. D FIELD^DID(FILE,FLD,"","SET OF CODES","RESULTS")
  1. S FOUND=0
  1. F ITEM=1:1:$L(RESULTS("SET OF CODES"),";") D Q:FOUND
  1. .S CODE=$P(RESULTS("SET OF CODES"),";",ITEM) Q:'$L(CODE)
  1. .S INTCODE=$P(CODE,":"),EXTCODE=$P(CODE,":",2)
  1. .I INTVAL=INTCODE S RETURN=EXTCODE,FOUND=1
  1. Q $G(RETURN)
  1. ; Set of codes external to internal
  1. SOCEXT2INT(FILE,FLD,EXTVAL) ;
  1. N FOUND,ITEM,CODE,EXTCODE,RETURN,INTCODE,RESULTS
  1. I '$L($G(EXTVAL)) Q ""
  1. S EXTVAL=$$UP^XLFSTR(EXTVAL)
  1. D FIELD^DID(FILE,FLD,"","SET OF CODES","RESULTS")
  1. S FOUND=0
  1. F ITEM=1:1:$L(RESULTS("SET OF CODES"),";") D Q:FOUND
  1. .S CODE=$P(RESULTS("SET OF CODES"),";",ITEM) Q:'$L(CODE)
  1. .S INTCODE=$P(CODE,":"),EXTCODE=$P(CODE,":",2)
  1. .I EXTCODE=EXTVAL S RETURN=INTCODE,FOUND=1
  1. Q $G(RETURN)
  1. ;
  1. CHECKYN(VAR) ;
  1. I VAR'="Y",VAR'="N" Q 0
  1. Q 1
  1. ;
  1. CHECKYNBLANKDEL(VAR) ;
  1. I VAR'="Y",VAR'="N",VAR'="",VAR'="@" Q 0
  1. Q 1
  1. ;
  1. YNTOBOOL(VAR) ;convert a Y/N input param to 1 or 0
  1. Q $S(VAR="Y":1,VAR="N":0,1:VAR)
  1. ;
  1. CHECKFORDEL(SDERRORS,SDINPUTARRAY) ; Check top level array entries for @
  1. N SDSUB
  1. S SDSUB=""
  1. F S SDSUB=$O(SDINPUTARRAY(SDSUB)) Q:SDSUB="" D
  1. .I $G(SDINPUTARRAY(SDSUB))="@" D ERRLOG^SDES2JSON(.SDERRORS,459,SDSUB)
  1. Q
  1. ;
  1. CHECKFORDELMULT(SDERRORS,SDINPUTARRAY) ; Check subfile array entries for @
  1. N SDSUBFILE,SDIEN
  1. F SDSUBFILE="DIAGNOSIS","PROVIDER","PRIVILEGED USER","SPECIAL INSTRUCTIONS" D
  1. .S SDIEN=""
  1. .F S SDIEN=$O(SDINPUTARRAY(SDSUBFILE,SDIEN)) Q:SDIEN="" D
  1. ..I $G(SDINPUTARRAY(SDSUBFILE,SDIEN))="@" D ERRLOG^SDES2JSON(.SDERRORS,459,SDSUBFILE_": "_SDIEN)
  1. ..I SDSUBFILE="SPECIAL INSTRUCTIONS",$P($G(SDINPUTARRAY(SDSUBFILE,SDIEN)),"|",2)="@" D ERRLOG^SDES2JSON(.SDERRORS,459,SDSUBFILE_": "_SDIEN)
  1. ..I $G(SDINPUTARRAY(SDSUBFILE,SDIEN,"DEFAULT"))="@" D ERRLOG^SDES2JSON(.SDERRORS,459,SDSUBFILE_" DEFAULT: "_SDIEN)
  1. Q
  1. ; 862
  1. SENSITIVE(RESULT,DFN,SDDUZ,DGMSG,DGOPT) ;RPC/API entry point for patient sensitive & record access checks
  1. ;Output array (Required)
  1. ; RESULT(1)= -1-RPC/API failed
  1. ; Required variable not defined
  1. ; 0-No display/action required
  1. ; Not accessing own, employee, or sensitive record
  1. ; 1-Display warning message
  1. ; Sensitive and DG SENSITIVITY key holder
  1. ; or Employee and DG SECURITY OFFICER key holder
  1. ; 2-Display warning message/require OK to continue
  1. ; Sensitive and not a DG SENSITIVITY key holder
  1. ; Employee and not a DG SECURITY OFFICER key holder
  1. ; 3-Access to record denied
  1. ; Accessing own record
  1. ; 4-Access to Patient (#2) file records denied
  1. ; SSN not defined
  1. ; RESULT(2-10) = error or display messages
  1. ;
  1. ;Input parameters: DFN = Patient file entry (Required)
  1. ; SDDUZ = User (Required)
  1. ; DGMSG = If 1, generate message (optional)
  1. ; DGOPT = Option name^Menu text (Optional)
  1. ;
  1. K RESULT
  1. I $G(DFN)="" D Q
  1. .S RESULT(1)=-1
  1. .S RESULT(2)="Required variable missing."
  1. S DGMSG=$G(DGMSG,0)
  1. D OWNREC^DGSEC4(.RESULT,DFN,$G(SDDUZ),DGMSG)
  1. I RESULT(1)=1 S RESULT(1)=3 Q
  1. I RESULT(1)=2 S RESULT(1)=4 Q
  1. K RESULT
  1. D SENS^DGSEC4(.RESULT,DFN,$G(SDDUZ))
  1. I RESULT(1)=1 D
  1. .I $G(SDDUZ)="" D Q
  1. ..;SDDUZ must be defined to access sensitive record & update DG Security log
  1. ..S RESULT(1)=-1
  1. ..S RESULT(2)="Your user code is undefined. This must be defined to access a restricted patient record."
  1. Q
  1. ;
  1. GETSUB(TXT) ;
  1. ; Output - Prior Number or Text with ~ delimiter
  1. ; Input - Number or Text
  1. N LAST
  1. S LAST=""
  1. I +TXT,+TXT=TXT S LAST=TXT-1 Q LAST ;- handle numeric
  1. S LAST=$E(TXT,$L(TXT))
  1. S LAST=$C($A(LAST)-1)
  1. S LAST=$E(TXT,1,$L(TXT)-1)_LAST_"~"
  1. Q LAST
  1. ;