GMTSRAS ; SLC/JER,KER HIN/GJC - Radiology Profile ; 04/19/2002
;;2.7;Health Summary;**14,25,28,37,47,51,84**;Oct 20, 1995;Build 6
;
; External References
; DBIA 3125 ^RADPT( file 70
; DBIA 2056 $$GET1^DIQ (file 70)
; DBIA 10011 ^DIWP
;
ENSRA ; Controls branching
Q:+($G(DFN))=0 Q:+($G(DFN))'=+($$RP(+($G(DFN))))
N GMDATA D MAIN^GMTSRAE(2) Q:'$D(^TMP("RAE",$J))
D LOOP K ^TMP("RAE",$J) Q
LOOP ; Loops through ^TMP("RAE",$J,
N GMW,GMTSORD,GMTSIDT,GMTSPN,GMLN,GMPSET,GMXSET S GMTSIDT=0
F S GMTSIDT=$O(^TMP("RAE",$J,GMTSIDT)) Q:GMTSIDT'>0 D Q:$D(GMTSQIT)
. S GMPSET=$S($D(^TMP("RAE",$J,GMTSIDT,"PRINTSET")):1,1:0)
. S GMXSET=$S($D(^TMP("RAE",$J,GMTSIDT,"EXAMSET")):1,1:0)
. S GMTSPN=0 F S GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) Q:GMTSPN'>0 D
. . S GMTSORD=+($P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,0)),"^",10))
. . D WRT D:+$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) BL Q:$D(GMTSQIT)
. D:+$O(^TMP("RAE",$J,GMTSIDT)) BL Q:$D(GMTSQIT)
Q
WRT ; Writes component data
Q:$D(GMTSQIT) N X,GMI,GMTMP S GMDATA=1,GMTMP=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,0))
D CKP^GMTSUP Q:$D(GMTSQIT)
D DAT,PRO D:'GMPSET SSET D:GMPSET PSET
Q
;
SSET ; Output for Non-Printsets (single exam) (GMPSET=0)
;
; Procedure Modifiers, Procedure Status,
; CPT Code, CPT Modifiers, Interpreting Staff,
; Interpreting Resident, Report Status,
; Technologist, Report Text
;
D:$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M")) PMD D CPT,CMD,INS,INR,CAS,EST,STT,RPT
Q
PSET ; Output for Printsets (GMPSET=1)
;
; Procedure Modifiers, Procedure Status,
; CPT Code, CPT Modifier, Report Status,
; Technologist
;
D:$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M")) PMD D CPT,CMD
D:'+$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) LSET
Q
LSET ; Last Set/Case in Printset
;
; Interpreting Staff, Interpreting Resident, Report Status,
; Technologist, Report Text
;
D BL,INS,INR,CAS,EST,STT N GMTSPN S GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,0)) D:GMTSPN RPT
Q
; Data Elements
DAT ; Date +1
Q:'$L($G(GMTMP)) Q:+($G(GMTMP))=0 Q:'$D(GMXSET) Q:'$D(GMTSPN) Q:+($G(GMTSIDT))=0
N X,GMTSDT S X=+GMTMP D REGDT4^GMTSU S GMTSDT=X
D CKP^GMTSUP Q:$D(GMTSQIT) W:+($G(GMXSET))=0 GMTSDT
W:(+($G(GMXSET))>0)&(GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,0))) GMTSDT
Q
PRO ; Procedure 2
Q:'$L($G(GMTMP)) N GMTSA,GMTSB S GMTSA=$P($G(GMTMP),"^",2)
S:$L(GMTSA)>65 GMTSA=$$WRAP^GMTSORC(GMTSA,65)
D CKP^GMTSUP Q:$D(GMTSQIT) W ?12,$P(GMTSA,"|"),!
F GMTSB=2:1:$L(GMTSA,"|") D Q:$D(GMTSQIT)
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W:$P(GMTSA,"|",GMTSB)]"" ?23,$P(GMTSA,"|",GMTSB),!
Q
CAS ; Case Number 9
Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",9) Q:GMTSA=""
Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
W ?12,"Exam Case Number:",?33,GMTSA,!
Q
EST ; Exam Status 3
Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",3) Q:GMTSA=""
Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
W ?12,"Exam Status:",?33,GMTSA,!
Q
RST ; Report Status 4
Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",4) Q:GMTSA=""
Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
W ?12,"Rpt Status: ",GMTSA,!
Q
INR ; Interpreting Resident 5
Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",5) Q:GMTSA=""
Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
W ?12,"Interpreting Res.:",?33,GMTSA,!
Q
INS ; Interpreting Staff 6
Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",6) Q:GMTSA=""
Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
W ?12,"Interpreting Staff:",?33,GMTSA,!
Q
CPT ; CPT Code 7
Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P($G(GMTMP),"^",7)
Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
W ?12,"CPT Code:",?25,GMTSA,!
Q
TEC ; Technologist 8
Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P($G(GMTMP),"^",8) Q:GMTSA=""
Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
W ?12," Technologist: ",GMTSA,!
Q
STT ; Report Status/Technologist 4/8
Q:'$L($G(GMTMP)) N GMTSA,GMTSB S GMTSA=$P(GMTMP,"^",4),GMTSB=$P(GMTMP,"^",8)
Q:($G(GMTSA)_$G(GMTSB))="" Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
W ?12,"Rpt Status: ",$E($G(GMTSA),1,18) W ?45," Technologist: ",$G(GMTSB),!
Q
CMD ; CPT Modifiers
N GMTSCPTM
S GMTSCPTM=+($$CPT^GMTSU(+($G(GMTSEGN)))) S:$G(GMPXCMOD)="N" GMTSCPTM=0
Q:'GMTSCPTM Q:'$L($G(GMTMP)) N GMTSC,GMTSCM,GMTSCT,GMTSI,GMTSCNT S (GMTSC,GMTSCNT)=0
F S GMTSC=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)) Q:+GMTSC=0 D
. S GMTSCM=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",1) Q:'$L(GMTSCM)
. S GMTSCT=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",3) Q:'$L(GMTSCT)
. S GMTSCT=GMTSCM_" - "_GMTSCT
. S GMTSCNT=GMTSCNT+1
. S:$L(GMTSCT)>47 GMTSCT=$$WRAP^GMTSORC(GMTSCT,47)
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W:GMTSCNT=1 ?12,"CPT Modifier:" W ?28,$P(GMTSCT,"|"),!
. F GMTSI=2:1:$L(GMTSCT,"|") D Q:$D(GMTSQIT)
. . D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTSCT,"|",GMTSI)]"" ?33,$P(GMTSCT,"|",GMTSI),!
Q
PMD ; Procedure Modifiers
Q:'$L($G(GMTMP)) D CKP^GMTSUP Q:$D(GMTSQIT) W:+($O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",0)))>0 ?12,"Procedure Modifier:"
S GMI=0 F S GMI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMI)) Q:+GMI'>0 D
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W ?33,^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMI),!
Q
;
RPT ; Report Text
N GMTSL F GMTSL="S","H","A","R","I","D" D TXT(GMTSL)
Q
TXT(X) ; Report Text Lines
N GMTST S GMTST=$E($G(X),1) Q:(GMTST="")!("^S^H^A^R^I^D^"'[GMTST)!(GMTST="^")
Q:GMTST="A"&(+($$PROK^GMTSU("RAUTL9",27))=0)
Q:+($G(GMTSIDT))=0 Q:+($G(GMTSPN))=0 Q:'$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST))
K ^UTILITY($J,"W") N GMTSI,GMTSII,GMTSIND,DIWF,DIWL,DIWR S GMTSIND=12,DIWF="C"_(78-(GMTSIND+2)),DIWL=0,DIWR=0,GMTSI=0
D:$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,0))>0 BL
D CKP^GMTSUP Q:$D(GMTSQIT)
W ?GMTSIND,$S(GMTST="S":"Reason for Study: ",GMTST="H":"History: ",GMTST="A":"Additional History: ",GMTST="R":"Report: ",GMTST="I":"Impression: ",GMTST="D":"DX Codes: ",1:"Text:"),!
I GMTST'="D" D
. S GMTSI=0 F S GMTSI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) Q:GMTSI'>0 D Q:$D(GMTSQIT)
. . S X=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) D ^DIWP
I GMTST="D" D
. S GMTSI=0 F S GMTSI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) Q:GMTSI'>0 D Q:$D(GMTSQIT)
. . S X=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) S:$L(X)>(78-(GMTSIND+4)) X=$$WRAP^GMTSORC(X,(78-(GMTSIND+4)))
. . D CKP^GMTSUP Q:$D(GMTSQIT) W ?(GMTSIND+2),$P(X,"|",1),! F GMTSII=2:1:$L(X,"|") D Q:$D(GMTSQIT)
. . . D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(X,"|",GMTSII)]"" ?(GMTSIND+4),$P(X,"|",GMTSII),!
I $D(^UTILITY($J,"W")) D
. S GMTSI=0 F S GMTSI=$O(^UTILITY($J,"W",0,GMTSI)) Q:+GMTSI=0 D Q:$D(GMTSQIT)
. . D CKP^GMTSUP Q:$D(GMTSQIT) W ?(GMTSIND+2),$G(^UTILITY($J,"W",0,GMTSI,0)),!
K ^UTILITY($J,"W")
Q
BL ; Report Blank Lines
D CKP^GMTSUP Q:$D(GMTSQIT) W ! Q
;
RP(X) ; Radiology Patient
N Y S X=+($G(X)) S Y=$$GET1^DIQ(70,X,.01,"I") S X=Y Q X
GMTSRAS ; SLC/JER,KER HIN/GJC - Radiology Profile ; 04/19/2002
+1 ;;2.7;Health Summary;**14,25,28,37,47,51,84**;Oct 20, 1995;Build 6
+2 ;
+3 ; External References
+4 ; DBIA 3125 ^RADPT( file 70
+5 ; DBIA 2056 $$GET1^DIQ (file 70)
+6 ; DBIA 10011 ^DIWP
+7 ;
ENSRA ; Controls branching
+1 IF +($GET(DFN))=0
QUIT
IF +($GET(DFN))'=+($$RP(+($GET(DFN))))
QUIT
+2 NEW GMDATA
DO MAIN^GMTSRAE(2)
IF '$DATA(^TMP("RAE",$JOB))
QUIT
+3 DO LOOP
KILL ^TMP("RAE",$JOB)
QUIT
LOOP ; Loops through ^TMP("RAE",$J,
+1 NEW GMW,GMTSORD,GMTSIDT,GMTSPN,GMLN,GMPSET,GMXSET
SET GMTSIDT=0
+2 FOR
SET GMTSIDT=$ORDER(^TMP("RAE",$JOB,GMTSIDT))
IF GMTSIDT'>0
QUIT
Begin DoDot:1
+3 SET GMPSET=$SELECT($DATA(^TMP("RAE",$JOB,GMTSIDT,"PRINTSET")):1,1:0)
+4 SET GMXSET=$SELECT($DATA(^TMP("RAE",$JOB,GMTSIDT,"EXAMSET")):1,1:0)
+5 SET GMTSPN=0
FOR
SET GMTSPN=$ORDER(^TMP("RAE",$JOB,GMTSIDT,GMTSPN))
IF GMTSPN'>0
QUIT
Begin DoDot:2
+6 SET GMTSORD=+($PIECE($GET(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,0)),"^",10))
+7 DO WRT
IF +$ORDER(^TMP("RAE",$JOB,GMTSIDT,GMTSPN))
DO BL
IF $DATA(GMTSQIT)
QUIT
End DoDot:2
+8 IF +$ORDER(^TMP("RAE",$JOB,GMTSIDT))
DO BL
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+9 QUIT
WRT ; Writes component data
+1 IF $DATA(GMTSQIT)
QUIT
NEW X,GMI,GMTMP
SET GMDATA=1
SET GMTMP=$GET(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,0))
+2 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+3 DO DAT
DO PRO
IF 'GMPSET
DO SSET
IF GMPSET
DO PSET
+4 QUIT
+5 ;
SSET ; Output for Non-Printsets (single exam) (GMPSET=0)
+1 ;
+2 ; Procedure Modifiers, Procedure Status,
+3 ; CPT Code, CPT Modifiers, Interpreting Staff,
+4 ; Interpreting Resident, Report Status,
+5 ; Technologist, Report Text
+6 ;
+7 IF $DATA(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"M"))
DO PMD
DO CPT
DO CMD
DO INS
DO INR
DO CAS
DO EST
DO STT
DO RPT
+8 QUIT
PSET ; Output for Printsets (GMPSET=1)
+1 ;
+2 ; Procedure Modifiers, Procedure Status,
+3 ; CPT Code, CPT Modifier, Report Status,
+4 ; Technologist
+5 ;
+6 IF $DATA(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"M"))
DO PMD
DO CPT
DO CMD
+7 IF '+$ORDER(^TMP("RAE",$JOB,GMTSIDT,GMTSPN))
DO LSET
+8 QUIT
LSET ; Last Set/Case in Printset
+1 ;
+2 ; Interpreting Staff, Interpreting Resident, Report Status,
+3 ; Technologist, Report Text
+4 ;
+5 DO BL
DO INS
DO INR
DO CAS
DO EST
DO STT
NEW GMTSPN
SET GMTSPN=$ORDER(^TMP("RAE",$JOB,GMTSIDT,0))
IF GMTSPN
DO RPT
+6 QUIT
+7 ; Data Elements
DAT ; Date +1
+1 IF '$LENGTH($GET(GMTMP))
QUIT
IF +($GET(GMTMP))=0
QUIT
IF '$DATA(GMXSET)
QUIT
IF '$DATA(GMTSPN)
QUIT
IF +($GET(GMTSIDT))=0
QUIT
+2 NEW X,GMTSDT
SET X=+GMTMP
DO REGDT4^GMTSU
SET GMTSDT=X
+3 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF +($GET(GMXSET))=0
WRITE GMTSDT
+4 IF (+($GET(GMXSET))>0)&(GMTSPN=$ORDER(^TMP("RAE",$JOB,GMTSIDT,0)))
WRITE GMTSDT
+5 QUIT
PRO ; Procedure 2
+1 IF '$LENGTH($GET(GMTMP))
QUIT
NEW GMTSA,GMTSB
SET GMTSA=$PIECE($GET(GMTMP),"^",2)
+2 IF $LENGTH(GMTSA)>65
SET GMTSA=$$WRAP^GMTSORC(GMTSA,65)
+3 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE ?12,$PIECE(GMTSA,"|"),!
+4 FOR GMTSB=2:1:$LENGTH(GMTSA,"|")
Begin DoDot:1
+5 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+6 IF $PIECE(GMTSA,"|",GMTSB)]""
WRITE ?23,$PIECE(GMTSA,"|",GMTSB),!
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+7 QUIT
CAS ; Case Number 9
+1 IF '$LENGTH($GET(GMTMP))
QUIT
NEW GMTSA
SET GMTSA=$PIECE(GMTMP,"^",9)
IF GMTSA=""
QUIT
+2 IF $DATA(GMTSQIT)
QUIT
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+3 WRITE ?12,"Exam Case Number:",?33,GMTSA,!
+4 QUIT
EST ; Exam Status 3
+1 IF '$LENGTH($GET(GMTMP))
QUIT
NEW GMTSA
SET GMTSA=$PIECE(GMTMP,"^",3)
IF GMTSA=""
QUIT
+2 IF $DATA(GMTSQIT)
QUIT
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+3 WRITE ?12,"Exam Status:",?33,GMTSA,!
+4 QUIT
RST ; Report Status 4
+1 IF '$LENGTH($GET(GMTMP))
QUIT
NEW GMTSA
SET GMTSA=$PIECE(GMTMP,"^",4)
IF GMTSA=""
QUIT
+2 IF $DATA(GMTSQIT)
QUIT
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+3 WRITE ?12,"Rpt Status: ",GMTSA,!
+4 QUIT
INR ; Interpreting Resident 5
+1 IF '$LENGTH($GET(GMTMP))
QUIT
NEW GMTSA
SET GMTSA=$PIECE(GMTMP,"^",5)
IF GMTSA=""
QUIT
+2 IF $DATA(GMTSQIT)
QUIT
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+3 WRITE ?12,"Interpreting Res.:",?33,GMTSA,!
+4 QUIT
INS ; Interpreting Staff 6
+1 IF '$LENGTH($GET(GMTMP))
QUIT
NEW GMTSA
SET GMTSA=$PIECE(GMTMP,"^",6)
IF GMTSA=""
QUIT
+2 IF $DATA(GMTSQIT)
QUIT
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+3 WRITE ?12,"Interpreting Staff:",?33,GMTSA,!
+4 QUIT
CPT ; CPT Code 7
+1 IF '$LENGTH($GET(GMTMP))
QUIT
NEW GMTSA
SET GMTSA=$PIECE($GET(GMTMP),"^",7)
+2 IF $DATA(GMTSQIT)
QUIT
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+3 WRITE ?12,"CPT Code:",?25,GMTSA,!
+4 QUIT
TEC ; Technologist 8
+1 IF '$LENGTH($GET(GMTMP))
QUIT
NEW GMTSA
SET GMTSA=$PIECE($GET(GMTMP),"^",8)
IF GMTSA=""
QUIT
+2 IF $DATA(GMTSQIT)
QUIT
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+3 WRITE ?12," Technologist: ",GMTSA,!
+4 QUIT
STT ; Report Status/Technologist 4/8
+1 IF '$LENGTH($GET(GMTMP))
QUIT
NEW GMTSA,GMTSB
SET GMTSA=$PIECE(GMTMP,"^",4)
SET GMTSB=$PIECE(GMTMP,"^",8)
+2 IF ($GET(GMTSA)_$GET(GMTSB))=""
QUIT
IF $DATA(GMTSQIT)
QUIT
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+3 WRITE ?12,"Rpt Status: ",$EXTRACT($GET(GMTSA),1,18)
WRITE ?45," Technologist: ",$GET(GMTSB),!
+4 QUIT
CMD ; CPT Modifiers
+1 NEW GMTSCPTM
+2 SET GMTSCPTM=+($$CPT^GMTSU(+($GET(GMTSEGN))))
IF $GET(GMPXCMOD)="N"
SET GMTSCPTM=0
+3 IF 'GMTSCPTM
QUIT
IF '$LENGTH($GET(GMTMP))
QUIT
NEW GMTSC,GMTSCM,GMTSCT,GMTSI,GMTSCNT
SET (GMTSC,GMTSCNT)=0
+4 FOR
SET GMTSC=$ORDER(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"CM",GMTSC))
IF +GMTSC=0
QUIT
Begin DoDot:1
+5 SET GMTSCM=$PIECE($GET(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",1)
IF '$LENGTH(GMTSCM)
QUIT
+6 SET GMTSCT=$PIECE($GET(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",3)
IF '$LENGTH(GMTSCT)
QUIT
+7 SET GMTSCT=GMTSCM_" - "_GMTSCT
+8 SET GMTSCNT=GMTSCNT+1
+9 IF $LENGTH(GMTSCT)>47
SET GMTSCT=$$WRAP^GMTSORC(GMTSCT,47)
+10 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+11 IF GMTSCNT=1
WRITE ?12,"CPT Modifier:"
WRITE ?28,$PIECE(GMTSCT,"|"),!
+12 FOR GMTSI=2:1:$LENGTH(GMTSCT,"|")
Begin DoDot:2
+13 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF $PIECE(GMTSCT,"|",GMTSI)]""
WRITE ?33,$PIECE(GMTSCT,"|",GMTSI),!
End DoDot:2
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
+14 QUIT
PMD ; Procedure Modifiers
+1 IF '$LENGTH($GET(GMTMP))
QUIT
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF +($ORDER(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"M",0)))>0
WRITE ?12,"Procedure Modifier:"
+2 SET GMI=0
FOR
SET GMI=$ORDER(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"M",GMI))
IF +GMI'>0
QUIT
Begin DoDot:1
+3 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+4 WRITE ?33,^TMP("RAE",$JOB,GMTSIDT,GMTSPN,"M",GMI),!
End DoDot:1
+5 QUIT
+6 ;
RPT ; Report Text
+1 NEW GMTSL
FOR GMTSL="S","H","A","R","I","D"
DO TXT(GMTSL)
+2 QUIT
TXT(X) ; Report Text Lines
+1 NEW GMTST
SET GMTST=$EXTRACT($GET(X),1)
IF (GMTST="")!("^S^H^A^R^I^D^"'[GMTST)!(GMTST="^")
QUIT
+2 IF GMTST="A"&(+($$PROK^GMTSU("RAUTL9",27))=0)
QUIT
+3 IF +($GET(GMTSIDT))=0
QUIT
IF +($GET(GMTSPN))=0
QUIT
IF '$DATA(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,GMTST))
QUIT
+4 KILL ^UTILITY($JOB,"W")
NEW GMTSI,GMTSII,GMTSIND,DIWF,DIWL,DIWR
SET GMTSIND=12
SET DIWF="C"_(78-(GMTSIND+2))
SET DIWL=0
SET DIWR=0
SET GMTSI=0
+5 IF $ORDER(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,GMTST,0))>0
DO BL
+6 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+7 WRITE ?GMTSIND,$SELECT(GMTST="S":"Reason for Study: ",GMTST="H":"History: ",GMTST="A":"Additional History: ",GMTST="R":"Report: ",GMTST="I":"Impression: ",GMTST="D":"DX Codes: ",1:"Text:"),!
+8 IF GMTST'="D"
Begin DoDot:1
+9 SET GMTSI=0
FOR
SET GMTSI=$ORDER(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,GMTST,GMTSI))
IF GMTSI'>0
QUIT
Begin DoDot:2
+10 SET X=$GET(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,GMTST,GMTSI))
DO ^DIWP
End DoDot:2
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
+11 IF GMTST="D"
Begin DoDot:1
+12 SET GMTSI=0
FOR
SET GMTSI=$ORDER(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,GMTST,GMTSI))
IF GMTSI'>0
QUIT
Begin DoDot:2
+13 SET X=$GET(^TMP("RAE",$JOB,GMTSIDT,GMTSPN,GMTST,GMTSI))
IF $LENGTH(X)>(78-(GMTSIND+4))
SET X=$$WRAP^GMTSORC(X,(78-(GMTSIND+4)))
+14 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE ?(GMTSIND+2),$PIECE(X,"|",1),!
FOR GMTSII=2:1:$LENGTH(X,"|")
Begin DoDot:3
+15 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF $PIECE(X,"|",GMTSII)]""
WRITE ?(GMTSIND+4),$PIECE(X,"|",GMTSII),!
End DoDot:3
IF $DATA(GMTSQIT)
QUIT
End DoDot:2
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
+16 IF $DATA(^UTILITY($JOB,"W"))
Begin DoDot:1
+17 SET GMTSI=0
FOR
SET GMTSI=$ORDER(^UTILITY($JOB,"W",0,GMTSI))
IF +GMTSI=0
QUIT
Begin DoDot:2
+18 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE ?(GMTSIND+2),$GET(^UTILITY($JOB,"W",0,GMTSI,0)),!
End DoDot:2
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
+19 KILL ^UTILITY($JOB,"W")
+20 QUIT
BL ; Report Blank Lines
+1 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE !
QUIT
+2 ;
RP(X) ; Radiology Patient
+1 NEW Y
SET X=+($GET(X))
SET Y=$$GET1^DIQ(70,X,.01,"I")
SET X=Y
QUIT X
