source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSROE.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1GMTSROE ; SLC/KER - Surgery Extract ; 06/24/2002 [7/28/04 8:40am]
2 ;;2.7;Health Summary;**37,57,71**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 2491 ^SRF( file #130
6 ; DBIA 10103 $$HTFM^XLFDT
7 ; DBIA 10015 EN^DIQ1
8 ; DBIA 1996 $$CPT^ICPTCOD
9 ; DBIA 10011 ^DIWP
10 ; DBIA 2056 $$GET1^DIQ (file #81.3)
11 ; DBIA 2056 $$GET1^DIQ (file #81)
12 ; DBIA 2056 $$GET1^DIQ (file #130)
13 ; DBIA 2052 FILE^DID
14 ;
15 Q
16ONE(X) ; Extract One Surgery Report
17 K REC N GMTSCPTM,GMSG,DA,DR,DIC,DIQ,IEN,IENS,FILE,FLD,FLDS,FLDI
18 N FLDA,FLDB,FLDR,FLDRT,IEN,GMTSI,GMTSRT,GMTST,GMTSS,GMTSC,GMTSCS
19 S GMTSCPTM=+($$CPT^GMTSU(+($G(GMTSEGN)))) S:$G(GMPXCMOD)="N" GMTSCPTM=0
20 Q:'$D(^SRF(X,0)) S (IENS,IEN,X)=+($G(X)),U="^"
21 S:'$D(DT) DT=$$HTFM^XLFDT($H,1) S:'$D(DTIME) DTIME=300
22 S (FILE,DIC)=130,DA=+($G(X)),DIQ="REC(",DIQ(0)="IE"
23 S GMSG=$$SG(IEN),REC(130,IEN,118,"E")=$S(GMSG=0:"YES",1:""),REC(130,IEN,118,"I")=$S(GMSG=0:"Y",1:"")
24 S:+GMSG DR=".09;.04;.14;.205;.22;.23;.31;1.15;10;15;17;26;27;32;34;36;39;43;49"
25 S:'GMSG DR=".09;.31;26;27;33;55;59;66;1.15;121;122;123;124;125"
26 D EN^DIQ1 S REC(130,IEN,"STATUS")=$$OS(IEN) S:+GMSG REC(130,IEN,"VERIFIED")=$S($G(REC(130,IEN,43,"I"))'="Y":"(Unverified)",1:"")
27 S GMTSM=$G(REC(130,IEN,27,"I")) I GMTSM>0 D
28 . S GMTSC=$$CPT^ICPTCOD(GMTSM),(GMTSCS,GMTSS)=$$EN2^GMTSUMX($P(GMTSC,"^",3))
29 . S REC(130,IEN,27,"X")=$P(GMTSC,"^",2)_"^"_$P(GMTSC,"^",3)
30 . S GMTSC=$P(GMTSC,"^",2),GMTST=$$EN2^GMTSUMX($G(REC(130,IEN,26,"E")))
31 . S:$L(GMTSS)&(GMTSS'=GMTST) GMTST=GMTST_" - "_GMTSS
32 . S:$L(GMTSC)=5 GMTST=GMTST_" (CPT "_GMTSC_")",GMTSCS=GMTSCS_" (CPT "_GMTSC_")"
33 . S REC(130,IEN,27,"N")=GMTSS
34 . S (REC(130,IEN,26,"S"),REC(130,IEN,27,"S"))=GMTST
35 . S REC(130,IEN,27,"S")=GMTSCS
36 D SUB
37 S:$D(REC(130,IEN,32)) REC(130,IEN,32,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,32,"E")))
38 S:$D(REC(130,IEN,33)) REC(130,IEN,33,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,33,"E")))
39 S:$D(REC(130,IEN,34)) REC(130,IEN,34,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,34,"E")))
40 S:$D(REC(130,IEN,.04)) REC(130,IEN,.04,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,.04,"E")))
41 S:$D(REC(130,IEN,125)) REC(130,IEN,125,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,125,"E")))
42 I $L($G(REC(130,IEN,33,"S"))) D
43 . S:'$L($G(REC(130,IEN,66,"E"))) REC(130,IEN,33,"S")=$G(REC(130,IEN,33,"S"))_" (Unknown)"
44 . S:$L($G(REC(130,IEN,66,"E"))) REC(130,IEN,33,"S")=$G(REC(130,IEN,33,"S"))_" (ICD "_$G(REC(130,IEN,66,"E"))_")"
45 S:+($G(REC(130,IEN,.09,"I")))>0 REC(130,IEN,.09,"S")=$$ED^GMTSU($G(REC(130,IEN,.09,"I")))
46 S:+($G(REC(130,IEN,15,"I")))>0 REC(130,IEN,15,"S")=$$EDT^GMTSU($G(REC(130,IEN,15,"I")))
47 S:+($G(REC(130,IEN,39,"I"))) REC(130,IEN,39,"S")=$$EDT^GMTSU($G(REC(130,IEN,39,"I")))
48 S:+GMSG REC(130,IEN,"LAB")=$S($O(REC(130,IEN,49,0))>0:"Yes",1:"")
49 I 'GMSG D:+($O(REC(130,IEN,55,0)))>0 WP(IEN,55,58) D:+($O(REC(130,IEN,59,0)))>0 WP(IEN,59,58)
50 Q
51WP(X,Y,Z) ; Word Processing
52 N GMTSI,GMTSF,GMTSW,GMI,DIWF,DIWL,DIWR
53 S GMTSI=+($G(X)) Q:GMTSI=0!('$D(REC(130,GMTSI)))
54 S GMTSF=+($G(Y)) Q:GMTSF=0!('$D(REC(130,GMTSI,GMTSF)))
55 S GMTSW=+($G(Z)) Q:GMTSW'>0!(GMTSW>79)
56 Q:+($O(REC(130,GMTSI,GMTSF,0)))'>0
57 K ^UTILITY($J,"W") S DIWF="C"_GMTSW,DIWL=0,DIWR=0,GMI=0
58 F S GMI=$O(REC(130,GMTSI,GMTSF,GMI)) Q:+GMI=0 D
59 . S X=$G(REC(130,GMTSI,GMTSF,GMI)) D ^DIWP
60 S GMI=0 F S GMI=$O(^UTILITY($J,"W",0,GMI)) Q:+GMI=0 D
61 . S REC(130,GMTSI,GMTSF,"S",GMI)=$G(^UTILITY($J,"W",0,GMI,0))
62 . S REC(130,GMTSI,GMTSF,"S",0)=$G(REC(130,GMTSI,GMTSF,"S",0))+1
63 K ^UTILITY($J,"W")
64 Q
65OS(X) ; Obtains status for OR procedures
66 N GMN S GMN=+($G(X)) S X="" I $G(REC(130,GMN,118,"I"))="Y" D Q X
67 . S:+($G(REC(130,GMN,122,"I")))>0 X="(Completed)"
68 . S:+($G(REC(130,GMN,121,"I")))>0&(+($G(REC(130,GMN,122,"I")))'>0) X="Incomplete"
69 . S:X="" X="Unknown"
70 I +($G(REC(130,GMN,17,"I")))>0 D Q X
71 . S X=$S(+($G(REC(130,GMN,.205,"I")))>0:"(Aborted)",1:"Cancelled")
72 I +($G(REC(130,GMN,.23,"I")))>0 S X="(Completed)" Q X
73 I +($G(REC(130,GMN,.22,"I")))>0 S X="Incomplete" Q X
74 I +($G(REC(130,GMN,10,"I")))>0 S X="Scheduled" Q X
75 I +($G(REC(130,GMN,36,"I")))>0,+($G(REC(130,GMN,.22,"I")))'>0 S X="Requested" Q X
76 S X="Unknown"
77 Q X
78SUB ; Surgery Subfiles
79 N DA,DR,DIC,DIQ,IENS,FILE,FLD,FLDS,FLDI,FLDA,FLDB,FLDR,FLDRT,GMTSM,GMTSC,GMTSI,GMTSJ,STXT,SNAM,SCOD,SUB
80 I +GMSG D
81 . ; ^SRF(DO,14,I) .72
82 . ; Other Preop Diagnosis 14;0 130.17
83 . ; $P(^SRF(DO,14,I,0),U) .01
84 . ; Other Preop Diagnosis 0;1 Text
85 . S DA=IEN,(FILE,DIC)=130,SUB=130.17,DR=.72,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE"
86 . K REC(SUB) S GMTSI=0 F S GMTSI=$O(^SRF(+($G(IEN)),14,GMTSI)) Q:+GMTSI=0 D
87 . . S DA(SUB)=GMTSI D EN^DIQ1
88 . . S REC(130,IEN,130.17,GMTSI,.01,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,130.17,GMTSI,.01,"E")))
89 . ; ^SRF(DO,15,I) .74
90 . ; Other Postop Diagnosis 15;0 130.18
91 . ; $P(^SRF(DO,15,I,0),U) .01
92 . ; Other Postop Diagnosis 0;1 Text
93 . S DA=IEN,(FILE,DIC)=130,SUB=130.18,DR=.74,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE"
94 . K REC(SUB) S GMTSI=0 F S GMTSI=$O(^SRF(+($G(IEN)),15,GMTSI)) Q:+GMTSI=0 D
95 . . S DA(SUB)=GMTSI D EN^DIQ1
96 . . S REC(130,IEN,130.18,GMTSI,.01,"S")=$$EN2^GMTSUMX($G(REC(130,IEN,130.18,GMTSI,.01,"E")))
97 ; ^SRF(GMN,"OPMOD",I) 28
98 ; Primary Proc CPT Mod OPMOD;0 130.028
99 ; $P(^SRF(GMN,"OPMOD",I,0),U) .01
100 ; Primary Proc CPT Mod 0;1 Ptr 81.3
101 I GMTSCPTM D
102 . S DA=IEN,(FILE,DIC)=130,SUB=130.028,DR=28,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE"
103 . K REC(SUB) S GMTSI=0 F S GMTSI=$O(^SRF(+($G(IEN)),"OPMOD",GMTSI)) Q:+GMTSI=0 D
104 . . S DA(SUB)=GMTSI D EN^DIQ1
105 . . S GMTSM=+($G(REC(130,+($G(IEN)),SUB,+($G(GMTSI)),.01,"I")))
106 . . I GMTSM>0 D
107 . . . N GMTSMOD S GMTSMOD=$$MOD^ICPTMOD(+GMTSM)
108 . . . S GMTSC=$P(GMTSMOD,"^",2)
109 . . . S GMTSS=$P(GMTSMOD,"^",3)
110 . . . S REC(130,IEN,SUB,GMTSI,.01,"MID")=GMTSC
111 . . . S REC(130,IEN,SUB,GMTSI,.01,"MOD")=GMTSS
112 . . . S GMTST=$$EN2^GMTSUMX(GMTSS)
113 . . . S:$L(GMTSC) GMTST=GMTST_" (CPT Mod "_GMTSC_")"
114 . . . S REC(130,IEN,SUB,GMTSI,.01,"S")=GMTST
115 ; ^SRF(DO,13,I) .42
116 ; Other Proc 13;0 130.16
117 ; $P(^SRF(DO,13,I,0),U) .01
118 ; Other Proc 0;1 Text
119 ; $P(^SRF(DO,13,I,2),U) 3
120 ; Other Proc CPT Code 2;1 Ptr 81
121 S DA=IEN,(FILE,DIC)=130,SUB=130.16,DR=.42,DR(SUB)=".01;3",DIQ="REC(130,"_IEN_",",DIQ(0)="IE"
122 K REC(SUB) S GMTSI=0 F S GMTSI=$O(^SRF(+($G(IEN)),13,GMTSI)) Q:+GMTSI=0 D
123 . N GMTSCPT S DA(SUB)=GMTSI
124 . D EN^DIQ1 S GMTSM=+($G(REC(130,IEN,130.16,GMTSI,3,"I")))
125 . S GMTSCPT=$$CPT^ICPTCOD(+GMTSM)
126 . S:GMTSM>0 REC(130,IEN,130.16,GMTSI,3,"N")=$P(GMTSCPT,"^",3)
127 . N GMTST,GMTSS,GMTSC S GMTSM=$G(REC(130,IEN,130.16,GMTSI,3,"I")) I GMTSM>0 D
128 . . S GMTSC=$$CPT^ICPTCOD(GMTSM),(GMTSCS,GMTSS)=$$EN2^GMTSUMX($P(GMTSC,"^",3))
129 . . S REC(130,IEN,130.16,GMTSI,3,"X")=$P(GMTSC,"^",2)_"^"_$P(GMTSC,"^",3)
130 . . S GMTSC=$P(GMTSC,"^",2)
131 . . S GMTST=$$EN2^GMTSUMX($G(REC(130,IEN,130.16,GMTSI,.01,"E")))
132 . . S:$L(GMTSS)&(GMTSS'=GMTST) GMTST=GMTST_" - "_$$EN2^GMTSUMX(GMTSS)
133 . . S:$L(GMTSC)=5 GMTST=GMTST_" (CPT "_GMTSC_")",GMTSCS=GMTSCS_" (CPT "_GMTSC_")"
134 . . S REC(130,IEN,130.16,GMTSI,3,"N")=GMTSS
135 . . S REC(130,IEN,130.16,GMTSI,.01,"S")=GMTST
136 . . S REC(130,IEN,130.16,GMTSI,3,"S")=GMTSCS
137 . ; ^SRF(8,13,2,"MOD",0) 4
138 . ; Oth Proc CPT Mod MOD;0 130.164
139 . ; ^SRF(8,13,2,"MOD",1,0) .01
140 . ; Oth Proc CPT Mod 0;1 Ptr 81.3
141 . I GMTSCPTM D
142 . . N GMTSJ S GMTSJ=0 F S GMTSJ=$O(^SRF(+($G(IEN)),13,GMTSI,"MOD",GMTSJ)) Q:+GMTSJ=0 D
143 . . . N DA,FILE,DIC,SUB,DR,DIQ S DA=IEN,DR=.42,FILE=130,SUB=130.16,DR(SUB)="4",DA(SUB)=GMTSI,SUB=130.164,DR(SUB)=".01",DA(SUB)=GMTSJ,DIC=130,DIQ="REC(130,"_IEN_",130.16,"_GMTSI_",",DIQ(0)="IE"
144 . . . D EN^DIQ1
145 . . . S GMTSM=+($G(REC(130,IEN,130.16,GMTSI,130.164,GMTSJ,.01,"I")))
146 . . . I GMTSM>0 D
147 . . . . N GMTSMOD S GMTSMOD=$$MOD^ICPTMOD(+GMTSM)
148 . . . . S GMTSC=$P(GMTSMOD,"^",2)
149 . . . . S GMTSS=$P(GMTSMOD,"^",3)
150 . . . . S REC(130,IEN,130.16,GMTSI,SUB,GMTSJ,.01,"MID")=GMTSC
151 . . . . S REC(130,IEN,130.16,GMTSI,SUB,GMTSJ,.01,"MOD")=GMTSS
152 . . . . S REC(130,IEN,130.16,GMTSI,SUB,GMTSJ,.01,"X")=GMTSC_"^"_GMTSS
153 . . . . S GMTST=$$EN2^GMTSUMX(GMTSS) S:$L(GMTSC) GMTST=GMTST_" (CPT Mod "_GMTSC_")"
154 . . . . S REC(130,IEN,130.16,GMTSI,SUB,GMTSJ,.01,"S")=GMTST
155 . . . K REC(130,IEN,130.16,GMTSI,130)
156 Q
157SORT ; Sort surgeries by inverted date
158 N GMDT S GMDT=$P(^SRF(GMN,0),U,9) I GMDT>GMTSBEG&(GMDT<GMTSEND) D
159 . F Q:'$D(SURG(9999999-GMDT)) S GMDT=GMDT+.0001
160 . S SURG(9999999-GMDT)=GMN
161 Q
162GL(X) ; Global Location
163 N FIL D FILE^DID(130,"N","GLOBAL NAME","FIL","FIL(""ERR"")") S X=$G(FIL("GLOBAL NAME"))
164 S:$E(X,1)'="^"!($E(X,2,$L(X))["^")!($L($E(X,2,$L(X)))<2)!($L($E(X,2,$L(X)))>8)!($E(X,2,$L(X))'["(") X=""
165 I $L(X) S:'$D(@($P(X,"(",1))) X=""
166 Q X
167SG(X) ; Surgical (Operative) Record
168 S X=$$GET1^DIQ(130,+($G(X)),118,"I") S X=$S(X["Y":0,1:1) Q X
Note: See TracBrowser for help on using the repository browser.