ISIJDCU1 ; ISI/MLS - ISIJ Dictation System Utilities ; 10/17/2022
;;1.1;ESL ISI IMAGING;**102,110**;Dec 21, 2022;Build 41
;; This routine is the property of ViTel Net, and should not be modified.
;; This software is a medical device and is subject to FDA regulation.
;; Modifications to this software may only be made under the terms of
;; 21CFR820 regulation. 21CFR Subpart A 820.1: "The failure to comply
;; with any applicable provision in this part renders a device
;; adulterated under section 501(h) of the act. Such a device,
;; as well as any person responsible for the failure to comply,
;; is subject to regulatory action."
; Reference to DBS^RAERR in ICR #7401
;
Q
;
; RPC = ISIJ RAD RPT DETAIL
; Provides report details for dictation
;
; 4/1/2020 -- Entry point also called via subroutine call from ISIJRPT
; to support ISI Rad Dictation "Version 2"; change key = DICTV2
;
;
; Input paramters:
; OUT = output array
; RACASE = DFN^RADTI^RACNI
; Where DFN is Patient DFN ; RADTI is Inverse exam date and RACNI is Case Num.
; DICTV2 = If positive, is both a Line Count initiator, AND a flag for alternate processing logic
;
; Output array:
; OUT(0) = 0 no results; n results; <0 error [-#^details^line tag^E]
; OUT(1) = Accession Num ^ Rpt IEN ^ Rpt Status ^ Rpt Status [internal] ^ Rpt Verify Date ^ Reported Date ^ Verifying Physician ^ Ver Phys DNF ^ Prim DX Code ^ Prim DX code [internal]
; OUT(n++) = "*RPT" [start report txt indicator]
; OUT(n++) = ...report text
; OUT(n++) = "*END_RPT" [end report txt indicator]
; OUT(n++) = "*IMP" [start of Impression text indicator]
; OUT(n++) = ...impression text
; OUT(n++) = "*END_IMP" [end report txt indicator]
; OUT(n++) = "*ACL" [start additional clin hist txt indicator]
; OUT(n++) = ...clin hist txt
; OUT(n++) = "*END_ACL" [end additional clin hist txt inicator]
; OUT(n++) = "*OCN" [start other case # list]
; OUT(n++) = ...other case #'s
; OUT(n++) = "*END_OCN" [end other case # list]
; OUT(n++) = "*SECDX"
; Secondary DX Code ^ DX code [internal]
; OUT(n++) = "*END_SECDX"
;
RPTSTAT(OUT,RACASE,DICTV2) ;
S DICTV2=$G(DICTV2,0) ; jhc--"dictation V2" has different needs; minor changes ID'd by this variable
N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIJDCU1"
N CNT,DFN,RADTI,RACNI,IENS7003,IENS7002,DIERR,RADTE,RABUF,RAMSG
N RACN,ACCNUM,RPTIEN,IENS74,RPTSTAT,RPTSTATI,VERDT,RPTDT,VERPHYS,VERPHYSI
N PRIMDXCD,PRIMDXI,ZFLD,SECDX
S U="^" K OUT S (OUT(0),CNT)=0
I DICTV2 S CNT=DICTV2 ; dict V2 mod
Q:RACASE=""
S DFN=$P(RACASE,U) Q:DFN=""
S RADTI=$P(RACASE,U,2) Q:RADTI=""
S RACNI=$P(RACASE,U,3) Q:RACNI=""
;
;Get IENs
S IENS7003=$$EXAMIENS^RAMAGU04(RACASE)
S IENS7002=$P(IENS7003,",",2,4)
;
S RADTE=$$GET1^DIQ(70.02,IENS7002,.01,"I",,"RAMSG")
I $G(DIERR) S OUT(0)=$$DBS^RAERR("RAMSG",-9,70.02,IENS7002) Q
;
;--- Get the report IEN
K RABUF,RAMSG
S ZFLD=".01;13;13.1*;17"
I $$VFIELD^DILFD(70.03,31) S ZFLD=ZFLD_";31" ;check to see if running MAG*49
D GETS^DIQ(70.03,IENS7003,ZFLD,"IE","RABUF","RAMSG")
I $G(DIERR) S OUT(0)=$$DBS^RAERR("RAMSG",-9,70.03,IENS7003) Q
S RACN=$G(RABUF(70.03,IENS7003,.01,"I"))
S PRIMDXCD=$G(RABUF(70.03,IENS7003,13,"E"))
S PRIMDXI=$G(RABUF(70.03,IENS7003,13,"I"))
S RPTIEN=$G(RABUF(70.03,IENS7003,17,"I"))
I RPTIEN'>0 S OUT(0)="0" Q ; No report yet
S ACCNUM=$G(RABUF(70.03,IENS7003,31,"I")) ;long acccession #
;
; if long accession # not used, construct short
S:ACCNUM="" ACCNUM=$$ACCNUM^RAMAGU04(RADTE,RACN,"S") ;
;
; save Secondary DX codes for later processing
M SECDX(70.14)=RABUF(70.14)
;
;--- Get the Report details
K RABUF,RAMSG
S IENS74=(RPTIEN)_","
D GETS^DIQ(74,IENS74,"4.5*;5;7;8;9;200;300;400","IE","RABUF","RAMSG") ; was missing ;8
I $G(DIERR) S OUT(0)=$$DBS^RAERR("RAMSG",-9,74,IENS74) Q
S RPTSTAT=$G(RABUF(74,IENS74,5,"E"))
S RPTSTATI=$G(RABUF(74,IENS74,5,"I"))
S VERDT=$G(RABUF(74,IENS74,7,"E"))
S RPTDT=$G(RABUF(74,IENS74,8,"E"))
S VERPHYS=$G(RABUF(74,IENS74,9,"E"))
S VERPHYSI=$G(RABUF(74,IENS74,9,"I"))
;
; assemble detail string
; DICTV2-Begin
I +$G(DICTV2) D G RPTSTATZ
. N SECDX2,HIT
. ; get: REPORT TEXT (200), IMPRESSION TEXT (300)
. D WP("RABUF(74,"""_IENS74_""",200)","REPORT",.HIT)
. I HIT S OUT(CNT)="*REPORT_END" ; * this overwrites node from the subrtn
. D WP("RABUF(74,"""_IENS74_""",300)","IMPRESSION",.HIT)
. I HIT S OUT(CNT)="*IMPRESSION_END" ; * this overwrites node from the subrtn
. ; get 13.1 SECONDARY DX CODES; * only supporting one sec dx code in dictv2
. S SECDX2=""
. S X=$O(SECDX(70.14,0)) I X]"" S SECDX2=SECDX(70.14,X,.01,"I")
. S X=PRIMDXI_U_SECDX2
. I $L(X)>1 D ; only report if either value exists
. . S CNT=CNT+1,OUT(CNT)="*DXCODE"
. . S CNT=CNT+1,OUT(CNT)=PRIMDXI_U_SECDX2
. . S CNT=CNT+1,OUT(CNT)="*DXCODE_END"
. I '(DICTV2<CNT) S CNT=0 ; no rpt data found
; DICTV2-End
S CNT=CNT+1
S OUT(CNT)=ACCNUM_U_RPTIEN_U_RPTSTAT_U_RPTSTATI_U_VERDT_U_RPTDT_U_VERPHYS_U_VERPHYSI_U_PRIMDXCD_U_PRIMDXI
;
; get WP fields: REPORT TEXT (200), IMPRESSION TEXT (300), ADDITIONAL CLINICAL HISTORY (400)
D WP("RABUF(74,"""_IENS74_""",200)","RPT")
D WP("RABUF(74,"""_IENS74_""",300)","IMP")
D WP("RABUF(74,"""_IENS74_""",400)","ACL")
;
; get 4.5 OTHER CASE# (multiple)
D OCASE("RABUF(74.05)","OCN")
;
; get 13.1 SECONDARY DX CODES (multiple)
D SECDX("SECDX(70.14)","SECDX")
;
RPTSTATZ ;
S OUT(0)=CNT ;success
Q
;
; process word processor fields
WP(NODE,CROSS,HIT) ;
S HIT=1
S X=0 I '$O(@NODE@(X)) S HIT=0 Q
S CNT=CNT+1 S OUT(CNT)="*"_CROSS
S X=0 F S X=$O(@NODE@(X)) Q:'X D
. S CNT=CNT+1
. S OUT(CNT)=@NODE@(X)
S CNT=CNT+1 S OUT(CNT)="*END_"_CROSS
Q
;
; Process Other Cases (4.5) muliple
OCASE(NODE,CROSS) ;
S X=0 I '$O(@NODE@(X)) Q
S CNT=CNT+1 S OUT(CNT)="*"_CROSS
S X=0 F S X=$O(@NODE@(X)) Q:X="" D
. S CNT=CNT+1
. S OUT(CNT)=@NODE@(X,.01,"E")
S CNT=CNT+1 S OUT(CNT)="*END_"_CROSS
Q
;
; Process Secondary DX Code (13.1) muliple
SECDX(NODE,CROSS) ;
S X=0 I '$O(@NODE@(X)) Q
S CNT=CNT+1 S OUT(CNT)="*"_CROSS
S X=0 F S X=$O(@NODE@(X)) Q:X="" D
. S CNT=CNT+1
. S OUT(CNT)=@NODE@(X,.01,"E")_U_@NODE@(X,.01,"I")
S CNT=CNT+1 S OUT(CNT)="*END_"_CROSS
Q
;
ERR ;
S OUT(0)="-1^VISTA ERROR "_$$EC^%ZOSV
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HISIJDCU1 6476 printed Apr 09, 2024@21:46:33 Page 2
ISIJDCU1 ; ISI/MLS - ISIJ Dictation System Utilities ; 10/17/2022
+1 ;;1.1;ESL ISI IMAGING;**102,110**;Dec 21, 2022;Build 41
+2 ;; This routine is the property of ViTel Net, and should not be modified.
+3 ;; This software is a medical device and is subject to FDA regulation.
+4 ;; Modifications to this software may only be made under the terms of
+5 ;; 21CFR820 regulation. 21CFR Subpart A 820.1: "The failure to comply
+6 ;; with any applicable provision in this part renders a device
+7 ;; adulterated under section 501(h) of the act. Such a device,
+8 ;; as well as any person responsible for the failure to comply,
+9 ;; is subject to regulatory action."
+10 ; Reference to DBS^RAERR in ICR #7401
+11 ;
+12 QUIT
+13 ;
+14 ; RPC = ISIJ RAD RPT DETAIL
+15 ; Provides report details for dictation
+16 ;
+17 ; 4/1/2020 -- Entry point also called via subroutine call from ISIJRPT
+18 ; to support ISI Rad Dictation "Version 2"; change key = DICTV2
+19 ;
+20 ;
+21 ; Input paramters:
+22 ; OUT = output array
+23 ; RACASE = DFN^RADTI^RACNI
+24 ; Where DFN is Patient DFN ; RADTI is Inverse exam date and RACNI is Case Num.
+25 ; DICTV2 = If positive, is both a Line Count initiator, AND a flag for alternate processing logic
+26 ;
+27 ; Output array:
+28 ; OUT(0) = 0 no results; n results; <0 error [-#^details^line tag^E]
+29 ; OUT(1) = Accession Num ^ Rpt IEN ^ Rpt Status ^ Rpt Status [internal] ^ Rpt Verify Date ^ Reported Date ^ Verifying Physician ^ Ver Phys DNF ^ Prim DX Code ^ Prim DX code [internal]
+30 ; OUT(n++) = "*RPT" [start report txt indicator]
+31 ; OUT(n++) = ...report text
+32 ; OUT(n++) = "*END_RPT" [end report txt indicator]
+33 ; OUT(n++) = "*IMP" [start of Impression text indicator]
+34 ; OUT(n++) = ...impression text
+35 ; OUT(n++) = "*END_IMP" [end report txt indicator]
+36 ; OUT(n++) = "*ACL" [start additional clin hist txt indicator]
+37 ; OUT(n++) = ...clin hist txt
+38 ; OUT(n++) = "*END_ACL" [end additional clin hist txt inicator]
+39 ; OUT(n++) = "*OCN" [start other case # list]
+40 ; OUT(n++) = ...other case #'s
+41 ; OUT(n++) = "*END_OCN" [end other case # list]
+42 ; OUT(n++) = "*SECDX"
+43 ; Secondary DX Code ^ DX code [internal]
+44 ; OUT(n++) = "*END_SECDX"
+45 ;
RPTSTAT(OUT,RACASE,DICTV2) ;
+1 ; jhc--"dictation V2" has different needs; minor changes ID'd by this variable
SET DICTV2=$GET(DICTV2,0)
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^ISIJDCU1"
+3 NEW CNT,DFN,RADTI,RACNI,IENS7003,IENS7002,DIERR,RADTE,RABUF,RAMSG
+4 NEW RACN,ACCNUM,RPTIEN,IENS74,RPTSTAT,RPTSTATI,VERDT,RPTDT,VERPHYS,VERPHYSI
+5 NEW PRIMDXCD,PRIMDXI,ZFLD,SECDX
+6 SET U="^"
KILL OUT
SET (OUT(0),CNT)=0
+7 ; dict V2 mod
IF DICTV2
SET CNT=DICTV2
+8 if RACASE=""
QUIT
+9 SET DFN=$PIECE(RACASE,U)
if DFN=""
QUIT
+10 SET RADTI=$PIECE(RACASE,U,2)
if RADTI=""
QUIT
+11 SET RACNI=$PIECE(RACASE,U,3)
if RACNI=""
QUIT
+12 ;
+13 ;Get IENs
+14 SET IENS7003=$$EXAMIENS^RAMAGU04(RACASE)
+15 SET IENS7002=$PIECE(IENS7003,",",2,4)
+16 ;
+17 SET RADTE=$$GET1^DIQ(70.02,IENS7002,.01,"I",,"RAMSG")
+18 IF $GET(DIERR)
SET OUT(0)=$$DBS^RAERR("RAMSG",-9,70.02,IENS7002)
QUIT
+19 ;
+20 ;--- Get the report IEN
+21 KILL RABUF,RAMSG
+22 SET ZFLD=".01;13;13.1*;17"
+23 ;check to see if running MAG*49
IF $$VFIELD^DILFD(70.03,31)
SET ZFLD=ZFLD_";31"
+24 DO GETS^DIQ(70.03,IENS7003,ZFLD,"IE","RABUF","RAMSG")
+25 IF $GET(DIERR)
SET OUT(0)=$$DBS^RAERR("RAMSG",-9,70.03,IENS7003)
QUIT
+26 SET RACN=$GET(RABUF(70.03,IENS7003,.01,"I"))
+27 SET PRIMDXCD=$GET(RABUF(70.03,IENS7003,13,"E"))
+28 SET PRIMDXI=$GET(RABUF(70.03,IENS7003,13,"I"))
+29 SET RPTIEN=$GET(RABUF(70.03,IENS7003,17,"I"))
+30 ; No report yet
IF RPTIEN'>0
SET OUT(0)="0"
QUIT
+31 ;long acccession #
SET ACCNUM=$GET(RABUF(70.03,IENS7003,31,"I"))
+32 ;
+33 ; if long accession # not used, construct short
+34 ;
if ACCNUM=""
SET ACCNUM=$$ACCNUM^RAMAGU04(RADTE,RACN,"S")
+35 ;
+36 ; save Secondary DX codes for later processing
+37 MERGE SECDX(70.14)=RABUF(70.14)
+38 ;
+39 ;--- Get the Report details
+40 KILL RABUF,RAMSG
+41 SET IENS74=(RPTIEN)_","
+42 ; was missing ;8
DO GETS^DIQ(74,IENS74,"4.5*;5;7;8;9;200;300;400","IE","RABUF","RAMSG")
+43 IF $GET(DIERR)
SET OUT(0)=$$DBS^RAERR("RAMSG",-9,74,IENS74)
QUIT
+44 SET RPTSTAT=$GET(RABUF(74,IENS74,5,"E"))
+45 SET RPTSTATI=$GET(RABUF(74,IENS74,5,"I"))
+46 SET VERDT=$GET(RABUF(74,IENS74,7,"E"))
+47 SET RPTDT=$GET(RABUF(74,IENS74,8,"E"))
+48 SET VERPHYS=$GET(RABUF(74,IENS74,9,"E"))
+49 SET VERPHYSI=$GET(RABUF(74,IENS74,9,"I"))
+50 ;
+51 ; assemble detail string
+52 ; DICTV2-Begin
+53 IF +$GET(DICTV2)
Begin DoDot:1
+54 NEW SECDX2,HIT
+55 ; get: REPORT TEXT (200), IMPRESSION TEXT (300)
+56 DO WP("RABUF(74,"""_IENS74_""",200)","REPORT",.HIT)
+57 ; * this overwrites node from the subrtn
IF HIT
SET OUT(CNT)="*REPORT_END"
+58 DO WP("RABUF(74,"""_IENS74_""",300)","IMPRESSION",.HIT)
+59 ; * this overwrites node from the subrtn
IF HIT
SET OUT(CNT)="*IMPRESSION_END"
+60 ; get 13.1 SECONDARY DX CODES; * only supporting one sec dx code in dictv2
+61 SET SECDX2=""
+62 SET X=$ORDER(SECDX(70.14,0))
IF X]""
SET SECDX2=SECDX(70.14,X,.01,"I")
+63 SET X=PRIMDXI_U_SECDX2
+64 ; only report if either value exists
IF $LENGTH(X)>1
Begin DoDot:2
+65 SET CNT=CNT+1
SET OUT(CNT)="*DXCODE"
+66 SET CNT=CNT+1
SET OUT(CNT)=PRIMDXI_U_SECDX2
+67 SET CNT=CNT+1
SET OUT(CNT)="*DXCODE_END"
End DoDot:2
+68 ; no rpt data found
IF '(DICTV2<CNT)
SET CNT=0
End DoDot:1
GOTO RPTSTATZ
+69 ; DICTV2-End
+70 SET CNT=CNT+1
+71 SET OUT(CNT)=ACCNUM_U_RPTIEN_U_RPTSTAT_U_RPTSTATI_U_VERDT_U_RPTDT_U_VERPHYS_U_VERPHYSI_U_PRIMDXCD_U_PRIMDXI
+72 ;
+73 ; get WP fields: REPORT TEXT (200), IMPRESSION TEXT (300), ADDITIONAL CLINICAL HISTORY (400)
+74 DO WP("RABUF(74,"""_IENS74_""",200)","RPT")
+75 DO WP("RABUF(74,"""_IENS74_""",300)","IMP")
+76 DO WP("RABUF(74,"""_IENS74_""",400)","ACL")
+77 ;
+78 ; get 4.5 OTHER CASE# (multiple)
+79 DO OCASE("RABUF(74.05)","OCN")
+80 ;
+81 ; get 13.1 SECONDARY DX CODES (multiple)
+82 DO SECDX("SECDX(70.14)","SECDX")
+83 ;
RPTSTATZ ;
+1 ;success
SET OUT(0)=CNT
+2 QUIT
+3 ;
+4 ; process word processor fields
WP(NODE,CROSS,HIT) ;
+1 SET HIT=1
+2 SET X=0
IF '$ORDER(@NODE@(X))
SET HIT=0
QUIT
+3 SET CNT=CNT+1
SET OUT(CNT)="*"_CROSS
+4 SET X=0
FOR
SET X=$ORDER(@NODE@(X))
if 'X
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
+6 SET OUT(CNT)=@NODE@(X)
End DoDot:1
+7 SET CNT=CNT+1
SET OUT(CNT)="*END_"_CROSS
+8 QUIT
+9 ;
+10 ; Process Other Cases (4.5) muliple
OCASE(NODE,CROSS) ;
+1 SET X=0
IF '$ORDER(@NODE@(X))
QUIT
+2 SET CNT=CNT+1
SET OUT(CNT)="*"_CROSS
+3 SET X=0
FOR
SET X=$ORDER(@NODE@(X))
if X=""
QUIT
Begin DoDot:1
+4 SET CNT=CNT+1
+5 SET OUT(CNT)=@NODE@(X,.01,"E")
End DoDot:1
+6 SET CNT=CNT+1
SET OUT(CNT)="*END_"_CROSS
+7 QUIT
+8 ;
+9 ; Process Secondary DX Code (13.1) muliple
SECDX(NODE,CROSS) ;
+1 SET X=0
IF '$ORDER(@NODE@(X))
QUIT
+2 SET CNT=CNT+1
SET OUT(CNT)="*"_CROSS
+3 SET X=0
FOR
SET X=$ORDER(@NODE@(X))
if X=""
QUIT
Begin DoDot:1
+4 SET CNT=CNT+1
+5 SET OUT(CNT)=@NODE@(X,.01,"E")_U_@NODE@(X,.01,"I")
End DoDot:1
+6 SET CNT=CNT+1
SET OUT(CNT)="*END_"_CROSS
+7 QUIT
+8 ;
ERR ;
+1 SET OUT(0)="-1^VISTA ERROR "_$$EC^%ZOSV
+2 DO @^%ZOSF("ERRTN")
+3 if $QUIT
QUIT 1
QUIT
