- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSRAS 7252 printed Feb 18, 2025@23:26:22 Page 2
- 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