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

ISIJDCU1.m

Go to the documentation of this file. 
  1. ISIJDCU1 ; ISI/MLS - ISIJ Dictation System Utilities ; 10/17/2022
  1.  ;;1.1;ESL ISI IMAGING;**102,110**;Dec 21, 2022;Build 41
  1.  ;; This routine is the property of ViTel Net, and should not be modified.
  1.  ;; This software is a medical device and is subject to FDA regulation.
  1.  ;; Modifications to this software may only be made under the terms of
  1.  ;; 21CFR820 regulation.  21CFR Subpart A 820.1: "The failure to comply
  1.  ;; with any applicable provision in this part renders a device
  1.  ;; adulterated under section 501(h) of the act. Such a device,
  1.  ;; as well as any person responsible for the failure to comply,
  1.  ;; is subject to regulatory action."
  1.  ; Reference to DBS^RAERR in ICR #7401
  1.  ;
  1.  Q
  1.  ;
  1.  ; RPC = ISIJ RAD RPT DETAIL
  1.  ;       Provides report details for dictation
  1.  ;
  1.  ; 4/1/2020 -- Entry point also called via subroutine call from ISIJRPT
  1.  ;             to support ISI Rad Dictation "Version 2"; change key = DICTV2
  1.  ;
  1.  ;
  1.  ; Input paramters:
  1.  ; OUT = output array
  1.  ; RACASE = DFN^RADTI^RACNI
  1.  ;          Where DFN is Patient DFN ; RADTI is Inverse exam date and RACNI is Case Num.
  1.  ; DICTV2 = If positive, is both a Line Count initiator, AND a flag for alternate processing logic
  1.  ;
  1.  ; Output array:
  1.  ; OUT(0) = 0 no results; n results; <0 error [-#^details^line tag^E]
  1.  ; 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]
  1.  ; OUT(n++) = "*RPT"           [start report txt indicator]
  1.  ; OUT(n++) = ...report text
  1.  ; OUT(n++) = "*END_RPT"       [end report txt indicator]
  1.  ; OUT(n++) = "*IMP"           [start of Impression text indicator]
  1.  ; OUT(n++) = ...impression text
  1.  ; OUT(n++) = "*END_IMP"       [end report txt indicator]
  1.  ; OUT(n++) = "*ACL"           [start additional clin hist txt indicator]
  1.  ; OUT(n++) = ...clin hist txt
  1.  ; OUT(n++) = "*END_ACL"       [end additional clin hist txt inicator] 
  1.  ; OUT(n++) = "*OCN"           [start other case # list]
  1.  ; OUT(n++) = ...other case #'s
  1.  ; OUT(n++) = "*END_OCN"       [end other case # list]
  1.  ; OUT(n++) = "*SECDX"
  1.  ; Secondary DX Code ^ DX code [internal]
  1.  ; OUT(n++) = "*END_SECDX"
  1.  ; 
  1. RPTSTAT(OUT,RACASE,DICTV2) ;
  1.  S DICTV2=$G(DICTV2,0) ; jhc--"dictation V2" has different needs; minor changes ID'd by this variable
  1.  N $ETRAP,$ESTACK S $ETRAP="D ERR^ISIJDCU1"
  1.  N CNT,DFN,RADTI,RACNI,IENS7003,IENS7002,DIERR,RADTE,RABUF,RAMSG
  1.  N RACN,ACCNUM,RPTIEN,IENS74,RPTSTAT,RPTSTATI,VERDT,RPTDT,VERPHYS,VERPHYSI
  1.  N PRIMDXCD,PRIMDXI,ZFLD,SECDX
  1.  S U="^" K OUT S (OUT(0),CNT)=0
  1.  I DICTV2 S CNT=DICTV2  ; dict V2 mod
  1.  Q:RACASE=""
  1.  S DFN=$P(RACASE,U) Q:DFN=""
  1.  S RADTI=$P(RACASE,U,2) Q:RADTI=""
  1.  S RACNI=$P(RACASE,U,3) Q:RACNI=""
  1.  ;
  1.  ;Get IENs
  1.  S IENS7003=$$EXAMIENS^RAMAGU04(RACASE)
  1.  S IENS7002=$P(IENS7003,",",2,4)
  1.  ;
  1.  S RADTE=$$GET1^DIQ(70.02,IENS7002,.01,"I",,"RAMSG")
  1.  I $G(DIERR) S OUT(0)=$$DBS^RAERR("RAMSG",-9,70.02,IENS7002) Q
  1.  ;
  1.  ;--- Get the report IEN
  1.  K RABUF,RAMSG
  1.  S ZFLD=".01;13;13.1*;17"
  1.  I $$VFIELD^DILFD(70.03,31) S ZFLD=ZFLD_";31" ;check to see if running MAG*49
  1.  D GETS^DIQ(70.03,IENS7003,ZFLD,"IE","RABUF","RAMSG")
  1.  I $G(DIERR) S OUT(0)=$$DBS^RAERR("RAMSG",-9,70.03,IENS7003) Q
  1.  S RACN=$G(RABUF(70.03,IENS7003,.01,"I"))
  1.  S PRIMDXCD=$G(RABUF(70.03,IENS7003,13,"E"))
  1.  S PRIMDXI=$G(RABUF(70.03,IENS7003,13,"I"))
  1.  S RPTIEN=$G(RABUF(70.03,IENS7003,17,"I"))
  1.  I RPTIEN'>0 S OUT(0)="0" Q  ; No report yet
  1.  S ACCNUM=$G(RABUF(70.03,IENS7003,31,"I")) ;long acccession #
  1.  ;
  1.  ; if long accession # not used, construct short 
  1.  S:ACCNUM="" ACCNUM=$$ACCNUM^RAMAGU04(RADTE,RACN,"S") ;
  1.  ;
  1.  ; save Secondary DX codes for later processing
  1.  M SECDX(70.14)=RABUF(70.14)
  1.  ;
  1.  ;--- Get the Report details
  1.  K RABUF,RAMSG
  1.  S IENS74=(RPTIEN)_","
  1.  D GETS^DIQ(74,IENS74,"4.5*;5;7;8;9;200;300;400","IE","RABUF","RAMSG")  ; was missing ;8
  1.  I $G(DIERR) S OUT(0)=$$DBS^RAERR("RAMSG",-9,74,IENS74) Q
  1.  S RPTSTAT=$G(RABUF(74,IENS74,5,"E"))
  1.  S RPTSTATI=$G(RABUF(74,IENS74,5,"I"))
  1.  S VERDT=$G(RABUF(74,IENS74,7,"E"))
  1.  S RPTDT=$G(RABUF(74,IENS74,8,"E"))
  1.  S VERPHYS=$G(RABUF(74,IENS74,9,"E"))
  1.  S VERPHYSI=$G(RABUF(74,IENS74,9,"I"))
  1.  ;
  1.  ; assemble detail string
  1.  ; DICTV2-Begin
  1.  I +$G(DICTV2) D  G RPTSTATZ
  1.  . N SECDX2,HIT
  1.  . ; get: REPORT TEXT (200), IMPRESSION TEXT (300)
  1.  . D WP("RABUF(74,"""_IENS74_""",200)","REPORT",.HIT)
  1.  . I HIT S OUT(CNT)="*REPORT_END"  ; * this overwrites node from the subrtn
  1.  . D WP("RABUF(74,"""_IENS74_""",300)","IMPRESSION",.HIT)
  1.  . I HIT S OUT(CNT)="*IMPRESSION_END"  ; * this overwrites node from the subrtn
  1.  . ; get 13.1 SECONDARY DX CODES;  * only supporting one sec dx code in dictv2
  1.  . S SECDX2=""
  1.  . S X=$O(SECDX(70.14,0)) I X]"" S SECDX2=SECDX(70.14,X,.01,"I")
  1.  . S X=PRIMDXI_U_SECDX2
  1.  . I $L(X)>1 D  ; only report if either value exists
  1.  . . S CNT=CNT+1,OUT(CNT)="*DXCODE"
  1.  . . S CNT=CNT+1,OUT(CNT)=PRIMDXI_U_SECDX2
  1.  . . S CNT=CNT+1,OUT(CNT)="*DXCODE_END"
  1.  . I '(DICTV2<CNT) S CNT=0  ; no rpt data found
  1.  ; DICTV2-End
  1.  S CNT=CNT+1
  1.  S OUT(CNT)=ACCNUM_U_RPTIEN_U_RPTSTAT_U_RPTSTATI_U_VERDT_U_RPTDT_U_VERPHYS_U_VERPHYSI_U_PRIMDXCD_U_PRIMDXI
  1.  ;
  1.  ; get WP fields:  REPORT TEXT (200), IMPRESSION TEXT (300), ADDITIONAL CLINICAL HISTORY (400)
  1.  D WP("RABUF(74,"""_IENS74_""",200)","RPT")
  1.  D WP("RABUF(74,"""_IENS74_""",300)","IMP")
  1.  D WP("RABUF(74,"""_IENS74_""",400)","ACL")
  1.  ;
  1.  ; get 4.5 OTHER CASE#  (multiple)
  1.  D OCASE("RABUF(74.05)","OCN")
  1.  ;
  1.  ; get 13.1 SECONDARY DX CODES  (multiple)
  1.  D SECDX("SECDX(70.14)","SECDX")
  1.  ;
  1. RPTSTATZ ;
  1.  S OUT(0)=CNT ;success
  1.  Q
  1.  ;
  1.  ; process word processor fields
  1. WP(NODE,CROSS,HIT) ;
  1.  S HIT=1
  1.  S X=0 I '$O(@NODE@(X))  S HIT=0 Q
  1.  S CNT=CNT+1 S OUT(CNT)="*"_CROSS
  1.  S X=0 F  S X=$O(@NODE@(X)) Q:'X  D
  1.  . S CNT=CNT+1
  1.  . S OUT(CNT)=@NODE@(X)
  1.  S CNT=CNT+1 S OUT(CNT)="*END_"_CROSS
  1.  Q
  1.  ;
  1.  ; Process Other Cases (4.5) muliple 
  1. OCASE(NODE,CROSS) ;
  1.  S X=0 I '$O(@NODE@(X)) Q
  1.  S CNT=CNT+1 S OUT(CNT)="*"_CROSS
  1.  S X=0 F  S X=$O(@NODE@(X)) Q:X=""  D
  1.  . S CNT=CNT+1
  1.  . S OUT(CNT)=@NODE@(X,.01,"E")
  1.  S CNT=CNT+1 S OUT(CNT)="*END_"_CROSS
  1.  Q
  1.  ;
  1.  ; Process Secondary DX Code (13.1) muliple
  1. SECDX(NODE,CROSS) ;
  1.  S X=0 I '$O(@NODE@(X)) Q
  1.  S CNT=CNT+1 S OUT(CNT)="*"_CROSS
  1.  S X=0 F  S X=$O(@NODE@(X)) Q:X=""  D
  1.  . S CNT=CNT+1
  1.  . S OUT(CNT)=@NODE@(X,.01,"E")_U_@NODE@(X,.01,"I")
  1.  S CNT=CNT+1 S OUT(CNT)="*END_"_CROSS
  1.  Q
  1.  ;
  1. ERR ;
  1.  S OUT(0)="-1^VISTA ERROR "_$$EC^%ZOSV
  1.  D @^%ZOSF("ERRTN")
  1.  Q:$Q 1  Q