Changeset 623 for WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRAS.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSRAS.m
r613 r623 1 GMTSRAS 2 ;;2.7;Health Summary;**14,25,28,37,47,51,84**;Oct 20, 1995;Build 6 3 4 5 6 7 8 9 ENSRA 10 11 12 13 LOOP 14 15 16 17 18 19 20 21 22 23 WRT 24 25 26 27 28 29 SSET 30 31 32 33 34 35 36 37 38 PSET 39 40 41 42 43 44 45 46 47 LSET 48 49 50 51 52 53 54 55 DAT 56 57 58 59 60 61 PRO 62 63 64 65 66 67 68 69 CAS 70 71 72 73 74 EST 75 76 77 78 79 RST 80 81 82 83 84 INR 85 86 87 88 89 INS 90 91 92 93 94 CPT 95 96 97 98 99 TEC 100 101 102 103 104 STT 105 106 107 108 109 CMD 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 PMD 125 126 127 128 129 130 131 RPT 132 N GMTSL F GMTSL="S","H","A","R","I","D" D TXT(GMTSL)133 134 TXT(X) 135 N GMTST S GMTST=$E($G(X),1) Q:(GMTST="")!("^S^H^A^R^I^D^"'[GMTST)!(GMTST="^")136 137 138 139 140 141 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:"),!142 143 144 145 146 147 148 149 150 151 152 153 154 155 BL 156 157 158 RP(X) 159 1 GMTSRAS ; 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 ; 9 ENSRA ; 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 13 LOOP ; 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 23 WRT ; 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 ; 29 SSET ; 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 38 PSET ; 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 47 LSET ; 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 55 DAT ; 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 61 PRO ; 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 69 CAS ; 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 74 EST ; 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 79 RST ; 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 84 INR ; 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 89 INS ; 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 94 CPT ; 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 99 TEC ; 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 104 STT ; 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 109 CMD ; 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 124 PMD ; 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 ; 131 RPT ; Report Text 132 N GMTSL F GMTSL="H","A","R","I","D" D TXT(GMTSL) 133 Q 134 TXT(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 155 BL ; Report Blank Lines 156 D CKP^GMTSUP Q:$D(GMTSQIT) W ! Q 157 ; 158 RP(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 TracChangeset
for help on using the changeset viewer.
