- 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 Feb 18, 2025@23:26:20 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