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