- 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 Jan 18, 2025@03:55:55 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 ;