source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRAS.m@ 677

Last change on this file since 677 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1GMTSRAS ; SLC/JER,KER HIN/GJC - Radiology Profile ; 04/19/2002
2 ;;2.7;Health Summary;**14,25,28,37,47,51**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 3125 ^RADPT( file 70
6 ; DBIA 2056 $$GET1^DIQ (file 70)
7 ; DBIA 10011 ^DIWP
8 ;
9ENSRA ; Controls branching
10 Q:+($G(DFN))=0 Q:+($G(DFN))'=+($$RP(+($G(DFN))))
11 N GMDATA D MAIN^GMTSRAE(2) Q:'$D(^TMP("RAE",$J))
12 D LOOP K ^TMP("RAE",$J) Q
13LOOP ; Loops through ^TMP("RAE",$J,
14 N GMW,GMTSORD,GMTSIDT,GMTSPN,GMLN,GMPSET,GMXSET S GMTSIDT=0
15 F S GMTSIDT=$O(^TMP("RAE",$J,GMTSIDT)) Q:GMTSIDT'>0 D Q:$D(GMTSQIT)
16 . S GMPSET=$S($D(^TMP("RAE",$J,GMTSIDT,"PRINTSET")):1,1:0)
17 . S GMXSET=$S($D(^TMP("RAE",$J,GMTSIDT,"EXAMSET")):1,1:0)
18 . S GMTSPN=0 F S GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) Q:GMTSPN'>0 D
19 . . S GMTSORD=+($P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,0)),"^",10))
20 . . D WRT D:+$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) BL Q:$D(GMTSQIT)
21 . D:+$O(^TMP("RAE",$J,GMTSIDT)) BL Q:$D(GMTSQIT)
22 Q
23WRT ; Writes component data
24 Q:$D(GMTSQIT) N X,GMI,GMTMP S GMDATA=1,GMTMP=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,0))
25 D CKP^GMTSUP Q:$D(GMTSQIT)
26 D DAT,PRO D:'GMPSET SSET D:GMPSET PSET
27 Q
28 ;
29SSET ; Output for Non-Printsets (single exam) (GMPSET=0)
30 ;
31 ; Procedure Modifiers, Procedure Status,
32 ; CPT Code, CPT Modifiers, Interpreting Staff,
33 ; Interpreting Resident, Report Status,
34 ; Technologist, Report Text
35 ;
36 D:$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M")) PMD D CPT,CMD,INS,INR,CAS,EST,STT,RPT
37 Q
38PSET ; Output for Printsets (GMPSET=1)
39 ;
40 ; Procedure Modifiers, Procedure Status,
41 ; CPT Code, CPT Modifier, Report Status,
42 ; Technologist
43 ;
44 D:$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M")) PMD D CPT,CMD
45 D:'+$O(^TMP("RAE",$J,GMTSIDT,GMTSPN)) LSET
46 Q
47LSET ; Last Set/Case in Printset
48 ;
49 ; Interpreting Staff, Interpreting Resident, Report Status,
50 ; Technologist, Report Text
51 ;
52 D BL,INS,INR,CAS,EST,STT N GMTSPN S GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,0)) D:GMTSPN RPT
53 Q
54 ; Data Elements
55DAT ; Date +1
56 Q:'$L($G(GMTMP)) Q:+($G(GMTMP))=0 Q:'$D(GMXSET) Q:'$D(GMTSPN) Q:+($G(GMTSIDT))=0
57 N X,GMTSDT S X=+GMTMP D REGDT4^GMTSU S GMTSDT=X
58 D CKP^GMTSUP Q:$D(GMTSQIT) W:+($G(GMXSET))=0 GMTSDT
59 W:(+($G(GMXSET))>0)&(GMTSPN=$O(^TMP("RAE",$J,GMTSIDT,0))) GMTSDT
60 Q
61PRO ; Procedure 2
62 Q:'$L($G(GMTMP)) N GMTSA,GMTSB S GMTSA=$P($G(GMTMP),"^",2)
63 S:$L(GMTSA)>65 GMTSA=$$WRAP^GMTSORC(GMTSA,65)
64 D CKP^GMTSUP Q:$D(GMTSQIT) W ?12,$P(GMTSA,"|"),!
65 F GMTSB=2:1:$L(GMTSA,"|") D Q:$D(GMTSQIT)
66 . D CKP^GMTSUP Q:$D(GMTSQIT)
67 . W:$P(GMTSA,"|",GMTSB)]"" ?23,$P(GMTSA,"|",GMTSB),!
68 Q
69CAS ; Case Number 9
70 Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",9) Q:GMTSA=""
71 Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
72 W ?12,"Exam Case Number:",?33,GMTSA,!
73 Q
74EST ; Exam Status 3
75 Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",3) Q:GMTSA=""
76 Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
77 W ?12,"Exam Status:",?33,GMTSA,!
78 Q
79RST ; Report Status 4
80 Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",4) Q:GMTSA=""
81 Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
82 W ?12,"Rpt Status: ",GMTSA,!
83 Q
84INR ; Interpreting Resident 5
85 Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",5) Q:GMTSA=""
86 Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
87 W ?12,"Interpreting Res.:",?33,GMTSA,!
88 Q
89INS ; Interpreting Staff 6
90 Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P(GMTMP,"^",6) Q:GMTSA=""
91 Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
92 W ?12,"Interpreting Staff:",?33,GMTSA,!
93 Q
94CPT ; CPT Code 7
95 Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P($G(GMTMP),"^",7)
96 Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
97 W ?12,"CPT Code:",?25,GMTSA,!
98 Q
99TEC ; Technologist 8
100 Q:'$L($G(GMTMP)) N GMTSA S GMTSA=$P($G(GMTMP),"^",8) Q:GMTSA=""
101 Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
102 W ?12," Technologist: ",GMTSA,!
103 Q
104STT ; Report Status/Technologist 4/8
105 Q:'$L($G(GMTMP)) N GMTSA,GMTSB S GMTSA=$P(GMTMP,"^",4),GMTSB=$P(GMTMP,"^",8)
106 Q:($G(GMTSA)_$G(GMTSB))="" Q:$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT)
107 W ?12,"Rpt Status: ",$E($G(GMTSA),1,18) W ?45," Technologist: ",$G(GMTSB),!
108 Q
109CMD ; CPT Modifiers
110 N GMTSCPTM
111 S GMTSCPTM=+($$CPT^GMTSU(+($G(GMTSEGN)))) S:$G(GMPXCMOD)="N" GMTSCPTM=0
112 Q:'GMTSCPTM Q:'$L($G(GMTMP)) N GMTSC,GMTSCM,GMTSCT,GMTSI,GMTSCNT S (GMTSC,GMTSCNT)=0
113 F S GMTSC=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)) Q:+GMTSC=0 D
114 . S GMTSCM=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",1) Q:'$L(GMTSCM)
115 . S GMTSCT=$P($G(^TMP("RAE",$J,GMTSIDT,GMTSPN,"CM",GMTSC)),"^",3) Q:'$L(GMTSCT)
116 . S GMTSCT=GMTSCM_" - "_GMTSCT
117 . S GMTSCNT=GMTSCNT+1
118 . S:$L(GMTSCT)>47 GMTSCT=$$WRAP^GMTSORC(GMTSCT,47)
119 . D CKP^GMTSUP Q:$D(GMTSQIT)
120 . W:GMTSCNT=1 ?12,"CPT Modifier:" W ?28,$P(GMTSCT,"|"),!
121 . F GMTSI=2:1:$L(GMTSCT,"|") D Q:$D(GMTSQIT)
122 . . D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTSCT,"|",GMTSI)]"" ?33,$P(GMTSCT,"|",GMTSI),!
123 Q
124PMD ; Procedure Modifiers
125 Q:'$L($G(GMTMP)) D CKP^GMTSUP Q:$D(GMTSQIT) W:+($O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",0)))>0 ?12,"Procedure Modifier:"
126 S GMI=0 F S GMI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMI)) Q:+GMI'>0 D
127 . D CKP^GMTSUP Q:$D(GMTSQIT)
128 . W ?33,^TMP("RAE",$J,GMTSIDT,GMTSPN,"M",GMI),!
129 Q
130 ;
131RPT ; Report Text
132 N GMTSL F GMTSL="H","A","R","I","D" D TXT(GMTSL)
133 Q
134TXT(X) ; Report Text Lines
135 N GMTST S GMTST=$E($G(X),1) Q:(GMTST="")!("^H^A^R^I^D^"'[GMTST)!(GMTST="^")
136 Q:GMTST="A"&(+($$PROK^GMTSU("RAUTL9",27))=0)
137 Q:+($G(GMTSIDT))=0 Q:+($G(GMTSPN))=0 Q:'$D(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST))
138 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
139 D:$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,0))>0 BL
140 D CKP^GMTSUP Q:$D(GMTSQIT)
141 W ?GMTSIND,$S(GMTST="H":"History: ",GMTST="A":"Additional History: ",GMTST="R":"Report: ",GMTST="I":"Impression: ",GMTST="D":"DX Codes: ",1:"Text:"),!
142 I GMTST'="D" D
143 . S GMTSI=0 F S GMTSI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) Q:GMTSI'>0 D Q:$D(GMTSQIT)
144 . . S X=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) D ^DIWP
145 I GMTST="D" D
146 . S GMTSI=0 F S GMTSI=$O(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) Q:GMTSI'>0 D Q:$D(GMTSQIT)
147 . . S X=$G(^TMP("RAE",$J,GMTSIDT,GMTSPN,GMTST,GMTSI)) S:$L(X)>(78-(GMTSIND+4)) X=$$WRAP^GMTSORC(X,(78-(GMTSIND+4)))
148 . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?(GMTSIND+2),$P(X,"|",1),! F GMTSII=2:1:$L(X,"|") D Q:$D(GMTSQIT)
149 . . . D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(X,"|",GMTSII)]"" ?(GMTSIND+4),$P(X,"|",GMTSII),!
150 I $D(^UTILITY($J,"W")) D
151 . S GMTSI=0 F S GMTSI=$O(^UTILITY($J,"W",0,GMTSI)) Q:+GMTSI=0 D Q:$D(GMTSQIT)
152 . . D CKP^GMTSUP Q:$D(GMTSQIT) W ?(GMTSIND+2),$G(^UTILITY($J,"W",0,GMTSI,0)),!
153 K ^UTILITY($J,"W")
154 Q
155BL ; Report Blank Lines
156 D CKP^GMTSUP Q:$D(GMTSQIT) W ! Q
157 ;
158RP(X) ; Radiology Patient
159 N Y S X=+($G(X)) S Y=$$GET1^DIQ(70,X,.01,"I") S X=Y Q X
Note: See TracBrowser for help on using the repository browser.