GMTSRAE ; SLC/JER,KER HIN/GJC Selected Radiology Extract ; 04/19/2002
;;2.7;Health Summary;**14,25,30,37,40,47,49,51,84**;Oct 20, 1995;Build 6
;
; External References
; DBIA 3125 ^RADPT( file 70
; DBIA 501 ^RARPT( file 74, fields 5, 200, 300 and 400
; DBIA 3417 ^RA(72, file 72, field 3 pending
; DBIA 502 ^RAMIS(71, file 71, field 9
; DBIA 10015 EN^DIQ1
; DBIA 2056 $$GET1^DIQ (files 71, 72, and 74)
; DBIA 2056 GETS^DIQ (file 70, subfile 70.03)
; DBIA 1995 $$CPT^ICPTCOD
; DBIA 10103 $$DT^XLFDT
; DBIA 10104 $$UP^XLFSTR
; DBIA 1996 $$MOD^ICPTMOD
; DBIA 10011 ^DIWP
;
MAINSEL(MODE,TEST) ; Entry for Selection Items
N GMTSIDT,GMTSIDT2,GMTSCNT,GMTSPN,GMTSMAX K ^TMP("RAE",$J) S GMTSCNT=0,GMTSMAX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:999)
S GMTSIDT=+GMTS1,GMTSIDT2=+($P(+GMTS2,".",1))_".999999"
S:+($G(GMTSPXGO))=0 GMTSIDT=$P(GMTS1,".",1),GMTSIDT2=$P(GMTS2,".",1)_".999999"
F S GMTSIDT=$O(^RADPT(DFN,"DT","AP",TEST,GMTSIDT)) Q:GMTSIDT'>0!(GMTSIDT>GMTSIDT2)!(GMTSCNT=GMTSMAX) D
. Q:'$D(^RADPT(DFN,"DT",GMTSIDT,0)) N GMTS7002,GMTSPSET,GMTSXSET
. S GMTS7002=$G(^RADPT(DFN,"DT",GMTSIDT,0))
. S GMTSXSET=+$P(GMTS7002,"^",5)
. S GMTSPN=0 F S GMTSPN=$O(^RADPT(DFN,"DT","AP",TEST,GMTSIDT,GMTSPN)) Q:GMTSPN'>0!(GMTSCNT=GMTSMAX) D
. . S GMTSCNT=GMTSCNT+1 D GET
Q
MAIN(MODE) ; Main Entry
N GMTSIDT,GMTSCNT,GMTSPN,GMTSMAX
K ^TMP("RAE",$J) S GMTSCNT=0,GMTSMAX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:999)
S GMTSIDT=+GMTS1,GMTSIDT2=+($P(+GMTS2,".",1))_".999999"
S:+($G(GMTSPXGO))=0 GMTSIDT=$P(GMTS1,".",1),GMTSIDT2=$P(GMTS2,".",1)_".999999"
F S GMTSIDT=$O(^RADPT(DFN,"DT",GMTSIDT)) Q:GMTSIDT'>0!(GMTSIDT>GMTSIDT2)!(GMTSCNT=GMTSMAX) D
. Q:'$D(^RADPT(DFN,"DT",GMTSIDT,0)) N GMTS7002,GMTSPSET,GMTSXSET
. S GMTS7002=$G(^RADPT(DFN,"DT",GMTSIDT,0))
. S GMTSXSET=+$P(GMTS7002,"^",5)
. S GMTSPN=0 F S GMTSPN=$O(^RADPT(DFN,"DT",GMTSIDT,"P",GMTSPN)) Q:GMTSPN'>0!(+GMTSCNT'<GMTSMAX) D
. . S GMTSCNT=GMTSCNT+1 D GET
Q
;
GET ; Gets data associated with study and sets global array
; ^TMP("RAE",$J, where:
;
; GMTSIDT = inverse exam date/time
; GMTSPN = Case IEN
;
; ^TMP("RAE",$J,GMTSIDT,GMTSPN,0)= <exam date> ^
; <procedure> ^ <exam status> ^ <report status> ^
; <prim interpret resident> ^ <prim interpret staff> ^
; <CPT code> ^ <technologist> ^ <case number> ^
; < exam status order >
;
; ^TMP("RAE",$J,GMTSIDT,"EXAMSET") Indicates if all
; exams for this date/time are part of an exam set
;
; ^TMP("RAE",$J,GMTSIDT,"PRINTSET") Indicates if all
; exams for this exam set share the same report
;
; Only if the report is verified -OR- released will
; these nodes be set
;
; ^TMP("RAE",$J,IDT,PN,"D",seq #) = Dx codes
; Sequence # = 1 Primary Dx
; Sequence # > 1 Secondary Dx
; ^TMP("RAE",$J,IDT,PN,"H",line #)= Clinical History line #
; ^TMP("RAE",$J,IDT,PN,"S",line #)= Reason for Study line #
; ^TMP("RAE",$J,IDT,PN,"I",line #)= Impression Text line #
; ^TMP("RAE",$J,IDT,PN,"R",line #)= Report Text line #
;
N DA,DIC,DIQ,%,D0,DIW,DIWI,DIWT,DIWTC,DIWX,DIWF,DIWL,DIWR,DN,DR
N I,J,Y,Z,GMTSCPT,GMTSED,GMTSCN,GMTSRP,GMTSRPI,GMTSST,GMTSPTR
N GMTSTA,GMTSTAI,GMTSI,GMTSRAD,GMTSRRAD,GMTSSRAD,GMTSTC,GMTSSTO
N GMTSIMGO,GMTSRA27 S GMTSRA27=$$PROK^GMTSU("RAUTL9",27)
S GMTSED=+$P(GMTS7002,"^")
S:GMTSXSET&('$D(^TMP("RAE",$J,GMTSIDT,"EXAMSET"))) ^TMP("RAE",$J,GMTSIDT,"EXAMSET")=""
; Get
; Exam Date $P($G(^RADPT(DFN,"DT",GMTSIDT,0)),"^",1)
; Exam Set $P($G(^RADPT(DFN,"DT",GMTSIDT,0)),"^",5)
; Case Number 70.03 .01 GMTSCN
; Procedure 70.03 2 GMTSRP/GMTSRPI
; Exam Status 70.03 3 GMTSST
; Imaging Order 70.03 11 GMTSIMGO
; Prim Interpret Resident 70.03 12 GMTSRRAD
; Prim Diagnostic Code 70.03 13 GMTSDX
; Prim Interpreting Staff 70.03 15 GMTSSRAD
; Report Text 70.03 17
; Member of Set 70.03 25
; Exam Status Order 72 3 GMTSSTO
;
S DIC="^RADPT("_DFN_",""DT"","_GMTSIDT_",""P"",",DA=GMTSPN,DIQ="GMTSRAD("
S DIQ(0)="IE",DR=".01;2;3;11;12;13;15;17;25" D TECH
D EN^DIQ1
S GMTSCN=$G(GMTSRAD(70.03,GMTSPN,.01,"E"))
S GMTSRP=$G(GMTSRAD(70.03,GMTSPN,2,"E"))
S GMTSRPI=$G(GMTSRAD(70.03,GMTSPN,2,"I"))
S GMTSST=$G(GMTSRAD(70.03,GMTSPN,3,"E"))
S GMTSSTO=$G(GMTSRAD(70.03,GMTSPN,3,"I"))
S GMTSSTO=$$GET1^DIQ(72,+GMTSSTO,3,"I")
S GMTSIMGO=$G(GMTSRAD(70.03,GMTSPN,11,"I")) ;Img Order # IEN
I GMTSTC S GMTSTC(0)=$E($G(GMTSRAD(70.12,GMTSTC,.01,"E")),1,18)
S GMTSRRAD=$E($G(GMTSRAD(70.03,GMTSPN,12,"E")),1,18)
S GMTSSRAD=$E($G(GMTSRAD(70.03,GMTSPN,15,"E")),1,18)
S GMTSPTR=$G(GMTSRAD(70.03,GMTSPN,17,"I"))
; Exam Set/Report
;
; If GMTSPSET = "" single exam
; If GMTSPSET = 1 exam set, single report
; If GMTSPSET = 2 exam set, combined report
;
S GMTSPSET=$G(GMTSRAD(70.03,GMTSPN,25,"I"))
D PMOD,CMOD I +GMTSPTR>0 S DIC="^RARPT(",DA=GMTSPTR,DIQ="GMTSRAD(",DIQ(0)="IE",DR="5" D EN^DIQ1
S GMTSTA=$G(GMTSRAD(74,+GMTSPTR,5,"E"))
S GMTSTAI=$G(GMTSRAD(74,+GMTSPTR,5,"I"))
I $L(GMTSTAI),("VR"[$E(GMTSTAI)) D GETDX(GMTSPN_","_GMTSIDT_","_DFN_",")
S GMTSCPT=$$GET1^DIQ(71,+GMTSRPI,9,"I")
S GMTSCPT=$S(+GMTSCPT>0:$P($$CPT^ICPTCOD(+GMTSCPT),"^",2),1:"")
S ^TMP("RAE",$J,GMTSIDT,GMTSPN,0)=GMTSED_U_GMTSRP_U_GMTSST_U_GMTSTA_U_GMTSRRAD_U_GMTSSRAD_U_GMTSCPT_U_$G(GMTSTC(0))_U_GMTSCN_U_$G(GMTSSTO)
S GMTSI=0 F S GMTSI=$O(GMTSRAD(70.1,GMTSI)) Q:+GMTSI'>0 D
. S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMTSI)=$G(GMTSRAD(70.1,GMTSI,.01,"E"))
S GMTSI=0 F S GMTSI=$O(GMTSRAD(70.1,GMTSI)) Q:+GMTSI'>0 D
. S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMTSI)=$G(GMTSRAD(70.1,GMTSI,.01,"E"))
S GMTSI=0 F S GMTSI=$O(GMTSRAD(70.3135,GMTSI)) Q:+GMTSI'>0 D
. Q:'$L($G(GMTSRAD(70.3135,GMTSI,.01,"M"))) Q:'$L($G(GMTSRAD(70.3135,GMTSI,.01,"N"))) N I S I=+($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",0)))+1
. S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",I)=$G(GMTSRAD(70.3135,GMTSI,.01,"M"))_"^"_$$UP^XLFSTR($G(GMTSRAD(70.3135,GMTSI,.01,"N")))_"^"_$G(GMTSRAD(70.3135,GMTSI,.01,"N")),^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",0)=I
; Only verified reports can be printed
I GMTSTAI'="V",($E(IOST)="P") D Q
. S:GMTSPSET=2 ^TMP("RAE",$J,GMTSIDT,"PRINTSET")=""
; Only verified & Released/Unverified can viewed
I $S(GMTSTAI="V":0,GMTSTAI="R":0,1:1) D Q
. S:GMTSPSET=2 ^TMP("RAE",$J,GMTSIDT,"PRINTSET")=""
Q:$D(^TMP("RAE",$J,GMTSIDT,"PRINTSET"))
D GETIMP D:$G(MODE)=2 GETHIS^GMTSRAE1,GETR4S^GMTSRAE1,GETADD,GETREP
S:GMTSPSET=2 ^TMP("RAE",$J,GMTSIDT,"PRINTSET")=""
Q
;
GETIMP ; Gets Radiologist's Impression
N X,GMTSLN S X=$$GET1^DIQ(74,GMTSPTR,300,,"GMTST")
K ^UTILITY($J,"W") N X,GMTSI S GMTSI=0 F S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0 S X=$G(GMTST(GMTSI)) D FORMAT
I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"I",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
K ^UTILITY($J,"W"),GMTST
Q
GETADD ; Gets Additional Clinical History (#74)
Q:+($G(GMTSRA27))'>0 N X,GMTSLN S X=$$GET1^DIQ(74,GMTSPTR,400,,"GMTST")
K ^UTILITY($J,"W") N X,GMTSI S GMTSI=0 F S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0 S X=$G(GMTST(GMTSI)) D FORMAT
I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) D
. S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"A",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
K ^UTILITY($J,"W"),GMTST
Q
GETREP ; Gets Radiologist's Report
N X,GMTSLN S X=$$GET1^DIQ(74,GMTSPTR,200,,"GMTST")
K ^UTILITY($J,"W") N X,I S GMTSI=0 F S GMTSI=$O(GMTST(GMTSI)) Q:+GMTSI=0 S X=$G(GMTST(GMTSI)) D FORMAT
I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",3) S ^TMP("RAE",$J,GMTSIDT,GMTSPN,"R",GMTSLN)=^UTILITY($J,"W",3,GMTSLN,0)
K ^UTILITY($J,"W"),GMTST
Q
PMOD ; Procedure Modifiers
N GMTS,GMTSI S GMTS=$G(DIC) Q:'$L(DIC) S GMTSI=+($G(DA)) Q:+GMTSI=0
N DIC,DA,DR S DIC=GMTS_GMTSI_",""M"","
S DA=0 F S DA=$O(@(DIC_DA_")")) Q:+DA'>0 S DR=".01" D
. D EN^DIQ1
Q
CMOD ; CPT Modifiers
N GMTS,GMTSI,GMTSC,GMTSCM,GMTSCN S GMTS=$G(DIC) Q:'$L(DIC) S GMTSI=+($G(DA)) Q:+GMTSI=0
S DT=$$DT^XLFDT,U="^" N DIC,DA,DR S DIC=GMTS_GMTSI_",""CMOD"","
S DA=0 F S DA=$O(@(DIC_DA_")")) Q:+DA'>0 S DR=".01" D EN^DIQ1
S GMTSI=0 F S GMTSI=$O(GMTSRAD(70.3135,GMTSI)) Q:+GMTSI=0 D
. S GMTSC=$G(GMTSRAD(70.3135,GMTSI,.01,"I")) Q:+GMTSC=0
. S GMTSCM=$$MOD^ICPTMOD(GMTSC,"I",)
. S GMTSCN=$P(GMTSCM,"^",3),GMTSCM=$P(GMTSCM,"^",2)
. S GMTSRAD(70.3135,GMTSI,.01,"M")=GMTSCM
. S GMTSRAD(70.3135,GMTSI,.01,"N")=$$EN2^GMTSUMX(GMTSCN)
Q
TECH ; Technician
S GMTSTC=+$O(^RADPT(DFN,"DT",GMTSIDT,"P",GMTSPN,"TC",0))
I GMTSTC S DR=$G(DR)_";175",DR(70.12)=.01,DA(70.12)=GMTSTC F Q:$E(DR,1)'=";" S DR=$E(DR,2,$L(DR))
Q
FORMAT ; Calls ^DIWP to format each line of text
N DIWL,DIWR,DIWF S DIWL=3,DIWR=($S(MODE=1:76,1:80))
D ^DIWP Q
;
GETDX(GMTSIEN) ; Set the data node with diagnostic code info.
;
; Input: GMTSIEN = Case IEN_","_exam date_","_DFN_","
; Output: ^TMP("RAE",$J,GMTSIDT,GMTSPN,"D",seq #) = Dx codes
;
; Sequence # = 1 Primary Dx
; Sequence # > 1 Secondary Dx
S ^TMP("RAE",$J,$P(GMTSIEN,",",2),$P(GMTSIEN,","),"D",1)=$G(GMTSRAD(70.03,$P(GMTSIEN,","),13,"E"))
N GMTSI,GMTSII,GMTSDX S GMTSI=1 D GETS^DIQ(70.03,GMTSIEN,"13.1*","E","GMTSDX")
S GMTSII="" F S GMTSII=$O(GMTSDX(70.14,GMTSII)) Q:GMTSII="" D
. S GMTSI=GMTSI+1 S ^TMP("RAE",$J,$P(GMTSIEN,",",2),$P(GMTSIEN,","),"D",GMTSI)=$G(GMTSDX(70.14,GMTSII,.01,"E"))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRAE 9726 printed Nov 22, 2024@17:10:05 Page 2
GMTSRAE ; SLC/JER,KER HIN/GJC Selected Radiology Extract ; 04/19/2002
+1 ;;2.7;Health Summary;**14,25,30,37,40,47,49,51,84**;Oct 20, 1995;Build 6
+2 ;
+3 ; External References
+4 ; DBIA 3125 ^RADPT( file 70
+5 ; DBIA 501 ^RARPT( file 74, fields 5, 200, 300 and 400
+6 ; DBIA 3417 ^RA(72, file 72, field 3 pending
+7 ; DBIA 502 ^RAMIS(71, file 71, field 9
+8 ; DBIA 10015 EN^DIQ1
+9 ; DBIA 2056 $$GET1^DIQ (files 71, 72, and 74)
+10 ; DBIA 2056 GETS^DIQ (file 70, subfile 70.03)
+11 ; DBIA 1995 $$CPT^ICPTCOD
+12 ; DBIA 10103 $$DT^XLFDT
+13 ; DBIA 10104 $$UP^XLFSTR
+14 ; DBIA 1996 $$MOD^ICPTMOD
+15 ; DBIA 10011 ^DIWP
+16 ;
MAINSEL(MODE,TEST) ; Entry for Selection Items
+1 NEW GMTSIDT,GMTSIDT2,GMTSCNT,GMTSPN,GMTSMAX
KILL ^TMP("RAE",$JOB)
SET GMTSCNT=0
SET GMTSMAX=$SELECT(+$GET(GMTSNDM)>0:GMTSNDM,1:999)
+2 SET GMTSIDT=+GMTS1
SET GMTSIDT2=+($PIECE(+GMTS2,".",1))_".999999"
+3 if +($GET(GMTSPXGO))=0
SET GMTSIDT=$PIECE(GMTS1,".",1)
SET GMTSIDT2=$PIECE(GMTS2,".",1)_".999999"
+4 FOR
SET GMTSIDT=$ORDER(^RADPT(DFN,"DT","AP",TEST,GMTSIDT))
if GMTSIDT'>0!(GMTSIDT>GMTSIDT2)!(GMTSCNT=GMTSMAX)
QUIT
Begin DoDot:1
+5 if '$DATA(^RADPT(DFN,"DT",GMTSIDT,0))
QUIT
NEW GMTS7002,GMTSPSET,GMTSXSET
+6 SET GMTS7002=$GET(^RADPT(DFN,"DT",GMTSIDT,0))
+7 SET GMTSXSET=+$PIECE(GMTS7002,"^",5)
+8 SET GMTSPN=0
FOR
SET GMTSPN=$ORDER(^RADPT(DFN,"DT","AP",TEST,GMTSIDT,GMTSPN))
if GMTSPN'>0!(GMTSCNT=GMTSMAX)
QUIT
Begin DoDot:2
+9 SET GMTSCNT=GMTSCNT+1
DO GET
End DoDot:2
End DoDot:1
+10 QUIT
MAIN(MODE) ; Main Entry
+1 NEW GMTSIDT,GMTSCNT,GMTSPN,GMTSMAX
+2 KILL ^TMP("RAE",$JOB)
SET GMTSCNT=0
SET GMTSMAX=$SELECT(+$GET(GMTSNDM)>0:GMTSNDM,1:999)
+3 SET GMTSIDT=+GMTS1
SET GMTSIDT2=+($PIECE(+GMTS2,".",1))_".999999"
+4 if +($GET(GMTSPXGO))=0
SET GMTSIDT=$PIECE(GMTS1,".",1)
SET GMTSIDT2=$PIECE(GMTS2,".",1)_".999999"
+5 FOR
SET GMTSIDT=$ORDER(^RADPT(DFN,"DT",GMTSIDT))
if GMTSIDT'>0!(GMTSIDT>GMTSIDT2)!(GMTSCNT=GMTSMAX)
QUIT
Begin DoDot:1
+6 if '$DATA(^RADPT(DFN,"DT",GMTSIDT,0))
QUIT
NEW GMTS7002,GMTSPSET,GMTSXSET
+7 SET GMTS7002=$GET(^RADPT(DFN,"DT",GMTSIDT,0))
+8 SET GMTSXSET=+$PIECE(GMTS7002,"^",5)
+9 SET GMTSPN=0
FOR
SET GMTSPN=$ORDER(^RADPT(DFN,"DT",GMTSIDT,"P",GMTSPN))
if GMTSPN'>0!(+GMTSCNT'<GMTSMAX)
QUIT
Begin DoDot:2
+10 SET GMTSCNT=GMTSCNT+1
DO GET
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
GET ; Gets data associated with study and sets global array
+1 ; ^TMP("RAE",$J, where:
+2 ;
+3 ; GMTSIDT = inverse exam date/time
+4 ; GMTSPN = Case IEN
+5 ;
+6 ; ^TMP("RAE",$J,GMTSIDT,GMTSPN,0)= <exam date> ^
+7 ; <procedure> ^ <exam status> ^ <report status> ^
+8 ; <prim interpret resident> ^ <prim interpret staff> ^
+9 ; <CPT code> ^ <technologist> ^ <case number> ^
+10 ; < exam status order >
+11 ;
+12 ; ^TMP("RAE",$J,GMTSIDT,"EXAMSET") Indicates if all
+13 ; exams for this date/time are part of an exam set
+14 ;
+15 ; ^TMP("RAE",$J,GMTSIDT,"PRINTSET") Indicates if all
+16 ; exams for this exam set share the same report
+17 ;
+18 ; Only if the report is verified -OR- released will
+19 ; these nodes be set
+20 ;
+21 ; ^TMP("RAE",$J,IDT,PN,"D",seq #) = Dx codes
+22 ; Sequence # = 1 Primary Dx
+23 ; Sequence # > 1 Secondary Dx
+24 ; ^TMP("RAE",$J,IDT,PN,"H",line #)= Clinical History line #
+25 ; ^TMP("RAE",$J,IDT,PN,"S",line #)= Reason for Study line #
+26 ; ^TMP("RAE",$J,IDT,PN,"I",line #)= Impression Text line #
+27 ; ^TMP("RAE",$J,IDT,PN,"R",line #)= Report Text line #
+28 ;
+29 NEW DA,DIC,DIQ,%,D0,DIW,DIWI,DIWT,DIWTC,DIWX,DIWF,DIWL,DIWR,DN,DR
+30 NEW I,J,Y,Z,GMTSCPT,GMTSED,GMTSCN,GMTSRP,GMTSRPI,GMTSST,GMTSPTR
+31 NEW GMTSTA,GMTSTAI,GMTSI,GMTSRAD,GMTSRRAD,GMTSSRAD,GMTSTC,GMTSSTO
+32 NEW GMTSIMGO,GMTSRA27
SET GMTSRA27=$$PROK^GMTSU("RAUTL9",27)
+33 SET GMTSED=+$PIECE(GMTS7002,"^")
+34 if GMTSXSET&('$DATA(^TMP("RAE",$JOB,GMTSIDT,"EXAMSET")))
SET ^TMP("RAE",$JOB,GMTSIDT,"EXAMSET")=""
+35 ; Get
+36 ; Exam Date $P($G(^RADPT(DFN,"DT",GMTSIDT,0)),"^",1)
+37 ; Exam Set $P($G(^RADPT(DFN,"DT",GMTSIDT,0)),"^",5)
+38 ; Case Number 70.03 .01 GMTSCN
+39 ; Procedure 70.03 2 GMTSRP/GMTSRPI
+40 ; Exam Status 70.03 3 GMTSST
+41 ; Imaging Order 70.03 11 GMTSIMGO
+42 ; Prim Interpret Resident 70.03 12 GMTSRRAD
+43 ; Prim Diagnostic Code 70.03 13 GMTSDX
+44 ; Prim Interpreting Staff 70.03 15 GMTSSRAD
+45 ; Report Text 70.03 17
+46 ; Member of Set 70.03 25
+47 ; Exam Status Order 72 3 GMTSSTO
+48 ;
+49 SET DIC="^RADPT("_DFN_",""DT"","_GMTSIDT_",""P"","
SET DA=GMTSPN
SET DIQ="GMTSRAD("
+50 SET DIQ(0)="IE"
SET DR=".01;2;3;11;12;13;15;17;25"
DO TECH
+51 DO EN^DIQ1
+52 SET GMTSCN=$GET(GMTSRAD(70.03,GMTSPN,.01,"E"))
+53 SET GMTSRP=$GET(GMTSRAD(70.03,GMTSPN,2,"E"))
+54 SET GMTSRPI=$GET(GMTSRAD(70.03,GMTSPN,2,"I"))
+55 SET GMTSST=$GET(GMTSRAD(70.03,GMTSPN,3,"E"))
+56 SET GMTSSTO=$GET(GMTSRAD(70.03,GMTSPN,3,"I"))
+57 SET GMTSSTO=$$GET1^DIQ(72,+GMTSSTO,3,"I")
+58 ;Img Order # IEN
SET GMTSIMGO=$GET(GMTSRAD(70.03,GMTSPN,11,"I"))
+59 IF GMTSTC
SET GMTSTC(0)=$EXTRACT($GET(GMTSRAD(70.12,GMTSTC,.01,"E")),1,18)
+60 SET GMTSRRAD=$EXTRACT($GET(GMTSRAD(70.03,GMTSPN,12,"E")),1,18)
+61 SET GMTSSRAD=$EXTRACT($GET(GMTSRAD(70.03,GMTSPN,15,"E")),1,18)
+62 SET GMTSPTR=$GET(GMTSRAD(70.03,GMTSPN,17,"I"))
+63 ; Exam Set/Report
+64 ;
+65 ; If GMTSPSET = "" single exam
+66 ; If GMTSPSET = 1 exam set, single report
+67 ; If GMTSPSET = 2 exam set, combined report
+68 ;
+69 SET GMTSPSET=$GET(GMTSRAD(70.03,GMTSPN,25,"I"))
+70 DO PMOD
DO CMOD
IF +GMTSPTR>0
SET DIC="^RARPT("
SET DA=GMTSPTR
SET DIQ="GMTSRAD("
SET DIQ(0)="IE"
SET DR="5"
DO EN^DIQ1
+71 SET GMTSTA=$GET(GMTSRAD(74,+GMTSPTR,5,"E"))
+72 SET GMTSTAI=$GET(GMTSRAD(74,+GMTSPTR,5,"I"))
+73 IF $LENGTH(GMTSTAI)
IF ("VR"[$EXTRACT(GMTSTAI))
DO GETDX(GMTSPN_","_GMTSIDT_","_DFN_",")
+74 SET GMTSCPT=$$GET1^DIQ(71,+GMTSRPI,9,"I")
+75 SET GMTSCPT=$SELECT(+GMTSCPT>0:$PIECE($$CPT^ICPTCOD(+GMTSCPT),"^",2),1:"")
+76 SET ^TMP("RAE",$JOB,GMTSIDT,GMTSPN,0)=GMTSED_U_GMTSRP_U_GMTSST_U_GMTSTA_U_GMTSRRAD_U_GMTSSRAD_U_GMTSCPT_U_$GET(GMTSTC(0))_U_GMTSCN_U_$GET(GMTSSTO)
+77 SET GMTSI=0
FOR
SET GMTSI=$ORDER(GMTSRAD(70.1,GMTSI))
if +GMTSI'>0
QUIT
Begin DoDot:1
+78 SET ^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"M",GMTSI)=$GET(GMTSRAD(70.1,GMTSI,.01,"E"))
End DoDot:1
+79 SET GMTSI=0
FOR
SET GMTSI=$ORDER(GMTSRAD(70.1,GMTSI))
if +GMTSI'>0
QUIT
Begin DoDot:1
+80 SET ^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"M",GMTSI)=$GET(GMTSRAD(70.1,GMTSI,.01,"E"))
End DoDot:1
+81 SET GMTSI=0
FOR
SET GMTSI=$ORDER(GMTSRAD(70.3135,GMTSI))
if +GMTSI'>0
QUIT
Begin DoDot:1
+82 if '$LENGTH($GET(GMTSRAD(70.3135,GMTSI,.01,"M")))
QUIT
if '$LENGTH($GET(GMTSRAD(70.3135,GMTSI,.01,"N")))
QUIT
NEW I
SET I=+($GET(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"CM",0)))+1
+83 SET ^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"CM",I)=$GET(GMTSRAD(70.3135,GMTSI,.01,"M"))_"^"_$$UP^XLFSTR($GET(GMTSRAD(70.3135,GMTSI,.01,"N")))_"^"_$GET(GMTSRAD(70.3135,GMTSI,.01,"N"))
SET ^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"CM",0)=I
End DoDot:1
+84 ; Only verified reports can be printed
+85 IF GMTSTAI'="V"
IF ($EXTRACT(IOST)="P")
Begin DoDot:1
+86 if GMTSPSET=2
SET ^TMP("RAE",$JOB,GMTSIDT,"PRINTSET")=""
End DoDot:1
QUIT
+87 ; Only verified & Released/Unverified can viewed
+88 IF $SELECT(GMTSTAI="V":0,GMTSTAI="R":0,1:1)
Begin DoDot:1
+89 if GMTSPSET=2
SET ^TMP("RAE",$JOB,GMTSIDT,"PRINTSET")=""
End DoDot:1
QUIT
+90 if $DATA(^TMP("RAE",$JOB,GMTSIDT,"PRINTSET"))
QUIT
+91 DO GETIMP
if $GET(MODE)=2
DO GETHIS^GMTSRAE1
DO GETR4S^GMTSRAE1
DO GETADD
DO GETREP
+92 if GMTSPSET=2
SET ^TMP("RAE",$JOB,GMTSIDT,"PRINTSET")=""
+93 QUIT
+94 ;
GETIMP ; Gets Radiologist's Impression
+1 NEW X,GMTSLN
SET X=$$GET1^DIQ(74,GMTSPTR,300,,"GMTST")
+2 KILL ^UTILITY($JOB,"W")
NEW X,GMTSI
SET GMTSI=0
FOR
SET GMTSI=$ORDER(GMTST(GMTSI))
if +GMTSI=0
QUIT
SET X=$GET(GMTST(GMTSI))
DO FORMAT
+3 IF $DATA(^UTILITY($JOB,"W"))
FOR GMTSLN=1:1:^UTILITY($JOB,"W",3)
SET ^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"I",GMTSLN)=^UTILITY($JOB,"W",3,GMTSLN,0)
+4 KILL ^UTILITY($JOB,"W"),GMTST
+5 QUIT
GETADD ; Gets Additional Clinical History (#74)
+1 if +($GET(GMTSRA27))'>0
QUIT
NEW X,GMTSLN
SET X=$$GET1^DIQ(74,GMTSPTR,400,,"GMTST")
+2 KILL ^UTILITY($JOB,"W")
NEW X,GMTSI
SET GMTSI=0
FOR
SET GMTSI=$ORDER(GMTST(GMTSI))
if +GMTSI=0
QUIT
SET X=$GET(GMTST(GMTSI))
DO FORMAT
+3 IF $DATA(^UTILITY($JOB,"W"))
FOR GMTSLN=1:1:^UTILITY($JOB,"W",3)
Begin DoDot:1
+4 SET ^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"A",GMTSLN)=^UTILITY($JOB,"W",3,GMTSLN,0)
End DoDot:1
+5 KILL ^UTILITY($JOB,"W"),GMTST
+6 QUIT
GETREP ; Gets Radiologist's Report
+1 NEW X,GMTSLN
SET X=$$GET1^DIQ(74,GMTSPTR,200,,"GMTST")
+2 KILL ^UTILITY($JOB,"W")
NEW X,I
SET GMTSI=0
FOR
SET GMTSI=$ORDER(GMTST(GMTSI))
if +GMTSI=0
QUIT
SET X=$GET(GMTST(GMTSI))
DO FORMAT
+3 IF $DATA(^UTILITY($JOB,"W"))
FOR GMTSLN=1:1:^UTILITY($JOB,"W",3)
SET ^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"R",GMTSLN)=^UTILITY($JOB,"W",3,GMTSLN,0)
+4 KILL ^UTILITY($JOB,"W"),GMTST
+5 QUIT
PMOD ; Procedure Modifiers
+1 NEW GMTS,GMTSI
SET GMTS=$GET(DIC)
if '$LENGTH(DIC)
QUIT
SET GMTSI=+($GET(DA))
if +GMTSI=0
QUIT
+2 NEW DIC,DA,DR
SET DIC=GMTS_GMTSI_",""M"","
+3 SET DA=0
FOR
SET DA=$ORDER(@(DIC_DA_")"))
if +DA'>0
QUIT
SET DR=".01"
Begin DoDot:1
+4 DO EN^DIQ1
End DoDot:1
+5 QUIT
CMOD ; CPT Modifiers
+1 NEW GMTS,GMTSI,GMTSC,GMTSCM,GMTSCN
SET GMTS=$GET(DIC)
if '$LENGTH(DIC)
QUIT
SET GMTSI=+($GET(DA))
if +GMTSI=0
QUIT
+2 SET DT=$$DT^XLFDT
SET U="^"
NEW DIC,DA,DR
SET DIC=GMTS_GMTSI_",""CMOD"","
+3 SET DA=0
FOR
SET DA=$ORDER(@(DIC_DA_")"))
if +DA'>0
QUIT
SET DR=".01"
DO EN^DIQ1
+4 SET GMTSI=0
FOR
SET GMTSI=$ORDER(GMTSRAD(70.3135,GMTSI))
if +GMTSI=0
QUIT
Begin DoDot:1
+5 SET GMTSC=$GET(GMTSRAD(70.3135,GMTSI,.01,"I"))
if +GMTSC=0
QUIT
+6 SET GMTSCM=$$MOD^ICPTMOD(GMTSC,"I",)
+7 SET GMTSCN=$PIECE(GMTSCM,"^",3)
SET GMTSCM=$PIECE(GMTSCM,"^",2)
+8 SET GMTSRAD(70.3135,GMTSI,.01,"M")=GMTSCM
+9 SET GMTSRAD(70.3135,GMTSI,.01,"N")=$$EN2^GMTSUMX(GMTSCN)
End DoDot:1
+10 QUIT
TECH ; Technician
+1 SET GMTSTC=+$ORDER(^RADPT(DFN,"DT",GMTSIDT,"P",GMTSPN,"TC",0))
+2 IF GMTSTC
SET DR=$GET(DR)_";175"
SET DR(70.12)=.01
SET DA(70.12)=GMTSTC
FOR
if $EXTRACT(DR,1)'=";"
QUIT
SET DR=$EXTRACT(DR,2,$LENGTH(DR))
+3 QUIT
FORMAT ; Calls ^DIWP to format each line of text
+1 NEW DIWL,DIWR,DIWF
SET DIWL=3
SET DIWR=($SELECT(MODE=1:76,1:80))
+2 DO ^DIWP
QUIT
+3 ;
GETDX(GMTSIEN) ; Set the data node with diagnostic code info.
+1 ;
+2 ; Input: GMTSIEN = Case IEN_","_exam date_","_DFN_","
+3 ; Output: ^TMP("RAE",$J,GMTSIDT,GMTSPN,"D",seq #) = Dx codes
+4 ;
+5 ; Sequence # = 1 Primary Dx
+6 ; Sequence # > 1 Secondary Dx
+7 SET ^TMP("RAE",$JOB,$PIECE(GMTSIEN,",",2),$PIECE(GMTSIEN,","),"D",1)=$GET(GMTSRAD(70.03,$PIECE(GMTSIEN,","),13,"E"))
+8 NEW GMTSI,GMTSII,GMTSDX
SET GMTSI=1
DO GETS^DIQ(70.03,GMTSIEN,"13.1*","E","GMTSDX")
+9 SET GMTSII=""
FOR
SET GMTSII=$ORDER(GMTSDX(70.14,GMTSII))
if GMTSII=""
QUIT
Begin DoDot:1
+10 SET GMTSI=GMTSI+1
SET ^TMP("RAE",$JOB,$PIECE(GMTSIEN,",",2),$PIECE(GMTSIEN,","),"D",GMTSI)=$GET(GMTSDX(70.14,GMTSII,.01,"E"))
End DoDot:1
+11 QUIT
