source: FOIAVistA/tag/r/SURGERY-SR/SROGMTS.m@ 1423

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

WorldVistAEHR overlayed on FOIAVistA
File size: 8.0 KB
Line 
1SROGMTS ;BIR/ADM - SURGERY HEALTH SUMMARY ; [ 08/08/01 7:12 AM ]
2 ;;3.0; Surgery ;**100,127**;24 Jun 93
3 ;
4 ;** NOTICE: This routine is part of an implementation of a nationally
5 ;** controlled procedure. Local modifications to this routine
6 ;** are prohibited.
7 ;
8 ; Reference to $$MOD^ICPTMOD supported by DBIA #1996
9 ; Reference to $$CPT^ICPTCOD supported by DBIA #1995
10 ;
11 Q
12HS(X) ; return case information for a surical or non-OR case
13 ; X - case number (IEN) in file 130
14 K REC N SRCPTM,SRSG,DA,DR,DIC,DIQ,IEN,IENS,FILE,FLD,FLDS,FLDI
15 N FLDA,FLDB,FLDR,FLDRT,IEN,SRI,SRRT,SRT,SRS,SRC,SRCS
16 S SRCPTM=1
17 Q:'$D(^SRF(X,0)) S (IENS,IEN,X)=+($G(X)),U="^"
18 S:'$D(DT) DT=$$HTFM^XLFDT($H,1) S:'$D(DTIME) DTIME=300
19 S (FILE,DIC)=130,DA=+($G(X)),DIQ="REC(",DIQ(0)="IE"
20 S SRSG=$$SG(IEN),REC(130,IEN,118,"E")=$S(SRSG=0:"YES",1:""),REC(130,IEN,118,"I")=$S(SRSG=0:"Y",1:"")
21 S:+SRSG DR=".09;.04;.14;.164;.205;.22;.23;.31;10;15;17;26;27;32;34;36;39;43;49;50"
22 S:'SRSG DR=".09;.31;26;27;33;50;55;59;66;121;122;123;124;125"
23 D EN^DIQ1 S REC(130,IEN,"STATUS")=$$OS(IEN) S:+SRSG REC(130,IEN,"VERIFIED")=$S($G(REC(130,IEN,43,"I"))'="Y":"(Unverified)",1:"")
24 S SRM=$G(REC(130,IEN,27,"I")) I SRM>0 D
25 . S SRC=$$CPT^ICPTCOD(SRM,$P($G(^SRF(IEN,0)),"^",9)),(SRCS,SRS)=$$EN2^SROGMTS0($P(SRC,"^",3))
26 . S REC(130,IEN,27,"X")=$P(SRC,"^",2)_"^"_$P(SRC,"^",3)
27 . S SRC=$P(SRC,"^",2),SRT=$$EN2^SROGMTS0($G(REC(130,IEN,26,"E")))
28 . S:$L(SRS)&(SRS'=SRT) SRT=SRT_" - "_SRS
29 . S:$L(SRC)=5 SRT=SRT_" (CPT "_SRC_")",SRCS=SRCS_" (CPT "_SRC_")"
30 . S REC(130,IEN,27,"N")=SRS
31 . S (REC(130,IEN,26,"S"),REC(130,IEN,27,"S"))=SRT
32 . S REC(130,IEN,27,"S")=SRCS
33 D DICT^SROGMTS0,SUB
34 S:$D(REC(130,IEN,32)) REC(130,IEN,32,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,32,"E")))
35 S:$D(REC(130,IEN,33)) REC(130,IEN,33,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,33,"E")))
36 S:$D(REC(130,IEN,34)) REC(130,IEN,34,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,34,"E")))
37 S:$D(REC(130,IEN,.04)) REC(130,IEN,.04,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,.04,"E")))
38 S:$D(REC(130,IEN,125)) REC(130,IEN,125,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,125,"E")))
39 I $L($G(REC(130,IEN,33,"S"))) D
40 . S:'$L($G(REC(130,IEN,66,"E"))) REC(130,IEN,33,"S")=$G(REC(130,IEN,33,"S"))_" (Unknown)"
41 . 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"))_")"
42 S:+($G(REC(130,IEN,.09,"I")))>0 REC(130,IEN,.09,"S")=$$ED^SROGMTS0($G(REC(130,IEN,.09,"I")))
43 S:+($G(REC(130,IEN,15,"I")))>0 REC(130,IEN,15,"S")=$$EDT^SROGMTS0($G(REC(130,IEN,15,"I")))
44 S:+($G(REC(130,IEN,39,"I"))) REC(130,IEN,39,"S")=$$EDT^SROGMTS0($G(REC(130,IEN,39,"I")))
45 S:+SRSG REC(130,IEN,"LAB")=$S($O(REC(130,IEN,49,0))>0:"Yes",1:"")
46 I 'SRSG D:+($O(REC(130,IEN,55,0)))>0 WP(IEN,55,58) D:+($O(REC(130,IEN,59,0)))>0 WP(IEN,59,58)
47 Q
48ED(X) ; external date
49 S X=$G(X) Q:'$L(X) ""
50 S X=$TR($$FMTE^XLFDT(X,"5DZ"),"@"," ")
51 Q X
52EDT(X) ; external date and time
53 S X=$G(X) Q:'$L(X) ""
54 S X=$TR($$FMTE^XLFDT(X,"2ZM"),"@"," ")
55 Q X
56WP(X,Y,Z) ;
57 N SRI,SRF,SRW,SRGI,DIWF,DIWL,DIWR
58 S SRI=+($G(X)) Q:SRI=0!('$D(REC(130,SRI)))
59 S SRF=+($G(Y)) Q:SRF=0!('$D(REC(130,SRI,SRF)))
60 S SRW=+($G(Z)) Q:SRW'>0!(SRW>79)
61 Q:+($O(REC(130,SRI,SRF,0)))'>0
62 K ^UTILITY($J,"W") S DIWF="C"_SRW,DIWL=0,DIWR=0,SRGI=0
63 F S SRGI=$O(REC(130,SRI,SRF,SRGI)) Q:+SRGI=0 D
64 . S X=$G(REC(130,SRI,SRF,SRGI))
65 . D ^DIWP
66 S SRGI=0 F S SRGI=$O(^UTILITY($J,"W",0,SRGI)) Q:+SRGI=0 D
67 . S REC(130,SRI,SRF,"S",SRGI)=$G(^UTILITY($J,"W",0,SRGI,0))
68 . S REC(130,SRI,SRF,"S",0)=$G(REC(130,SRI,SRF,"S",0))+1
69 K ^UTILITY($J,"W")
70 Q
71OS(X) ; Obtains status for OR procedures
72 N SRN S SRN=+($G(X)) S X="" I $G(REC(130,SRN,118,"I"))="Y" D Q X
73 . S:+($G(REC(130,SRN,122,"I")))>0 X="(Completed)"
74 . S:+($G(REC(130,SRN,121,"I")))>0&(+($G(REC(130,SRN,122,"I")))'>0) X="Incomplete"
75 . S:X="" X="Unknown"
76 I +($G(REC(130,SRN,17,"I")))>0 D Q X
77 . S X=$S(+($G(REC(130,SRN,.205,"I")))>0:"(Aborted)",1:"Cancelled")
78 I +($G(REC(130,SRN,.23,"I")))>0 S X="(Completed)" Q X
79 I +($G(REC(130,SRN,.22,"I")))>0 S X="Incomplete" Q X
80 I +($G(REC(130,SRN,10,"I")))>0 S X="Scheduled" Q X
81 I +($G(REC(130,SRN,36,"I")))>0,+($G(REC(130,SRN,.22,"I")))'>0 S X="Requested" Q X
82 S X="Unknown"
83 Q X
84SUB ;
85 N DA,DR,DIC,DIQ,IENS,FILE,FLD,FLDS,FLDI,FLDA,FLDB,FLDR,FLDRT,SRM,SRC,SRI,SRJ,STXT,SNAM,SCOD,SUB
86 I +SRSG D
87 . ;
88 . ; ^SRF(DO,14,I) .72 Other Preop Diag 14;0 130.17
89 . ; $P(^SRF(DO,14,I,0),U) .01 Other Preop Diag 0;1 Text
90 . ;
91 . S DA=IEN,(FILE,DIC)=130,SUB=130.17,DR=.72,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE"
92 . K REC(SUB) S SRI=0 F S SRI=$O(^SRF(+($G(IEN)),14,SRI)) Q:+SRI=0 D
93 . . S DA(SUB)=SRI
94 . . D EN^DIQ1
95 . . S REC(130,IEN,130.17,SRI,.01,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,130.17,SRI,.01,"E")))
96 . ;
97 . ; ^SRF(DO,15,I) .74 Other Postop Diags 15;0 130.18
98 . ; $P(^SRF(DO,15,I,0),U) .01 Other Postop Diags 0;1 Text
99 . ;
100 . S DA=IEN,(FILE,DIC)=130,SUB=130.18,DR=.74,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE"
101 . K REC(SUB) S SRI=0 F S SRI=$O(^SRF(+($G(IEN)),15,SRI)) Q:+SRI=0 D
102 . . S DA(SUB)=SRI
103 . . D EN^DIQ1
104 . . S REC(130,IEN,130.18,SRI,.01,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,130.18,SRI,.01,"E")))
105 ;
106 ; ^SRF(SRN,"OPMOD",I) 28 Pri Pro CPT Mod OPMOD;0 130.028
107 ; $P(^SRF(SRN,"OPMOD",I,0),U) .01 Pri Pro CPT Mod 0;1 Ptr 81.3
108 ;
109 I SRCPTM D
110 . S DA=IEN,(FILE,DIC)=130,SUB=130.028,DR=28,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE"
111 . K REC(SUB) S SRI=0 F S SRI=$O(^SRF(+($G(IEN)),"OPMOD",SRI)) Q:+SRI=0 D
112 . . S DA(SUB)=SRI
113 . . D EN^DIQ1
114 . . S SRM=+($G(REC(130,+($G(IEN)),SUB,+($G(SRI)),.01,"I")))
115 . . I SRM>0 N SRMOD D
116 . . . S SRMOD=$$MOD^ICPTMOD(+SRM,"I",$P($G(^SRF(IEN,0)),"^",9))
117 . . . S SRC=$P(SRMOD,"^",2)
118 . . . S SRS=$P(SRMOD,"^",3)
119 . . . S REC(130,IEN,SUB,SRI,.01,"MID")=SRC
120 . . . S REC(130,IEN,SUB,SRI,.01,"MOD")=SRS
121 . . . S SRT=$$EN2^SROGMTS0(SRS)
122 . . . S:$L(SRC) SRT=SRT_" (CPT Mod "_SRC_")"
123 . . . S REC(130,IEN,SUB,SRI,.01,"S")=SRT
124 ;
125 ; ^SRF(DO,13,I) .42 Other Proc 13;0 130.16
126 ; $P(^SRF(DO,13,I,0),U) .01 Other Proc 0;1 Text
127 ; $P(^SRF(DO,13,I,2),U) 3 Other Proc CPT Code 2;1 Ptr 81
128 ;
129 S DA=IEN,(FILE,DIC)=130,SUB=130.16,DR=.42,DR(SUB)=".01;3",DIQ="REC(130,"_IEN_",",DIQ(0)="IE"
130 K REC(SUB) S SRI=0 F S SRI=$O(^SRF(+($G(IEN)),13,SRI)) Q:+SRI=0 D
131 . S DA(SUB)=SRI
132 . D EN^DIQ1 S SRM=+($G(REC(130,IEN,130.16,SRI,3,"I")))
133 . S:SRM>0 REC(130,IEN,130.16,SRI,3,"N")=$P($$CPT^ICPTCOD(+SRM,$P($G(^SRF(IEN,0)),"^",9)),"^",3)
134 . N SRT,SRS,SRC S SRM=$G(REC(130,IEN,130.16,SRI,3,"I")) I SRM>0 D
135 . . S SRC=$$CPT^ICPTCOD(SRM,$P($G(^SRF(IEN,0)),"^",9)),(SRCS,SRS)=$$EN2^SROGMTS0($P(SRC,"^",3))
136 . . S REC(130,IEN,130.16,SRI,3,"X")=$P(SRC,"^",2)_"^"_$P(SRC,"^",3)
137 . . S SRC=$P(SRC,"^",2)
138 . . S SRT=$$EN2^SROGMTS0($G(REC(130,IEN,130.16,SRI,.01,"E")))
139 . . S:$L(SRS)&(SRS'=SRT) SRT=SRT_" - "_$$EN2^SROGMTS0(SRS)
140 . . S:$L(SRC)=5 SRT=SRT_" (CPT "_SRC_")",SRCS=SRCS_" (CPT "_SRC_")"
141 . . S REC(130,IEN,130.16,SRI,3,"N")=SRS
142 . . S REC(130,IEN,130.16,SRI,.01,"S")=SRT
143 . . S REC(130,IEN,130.16,SRI,3,"S")=SRCS
144 . ;
145 . ; ^SRF(8,13,2,"MOD",0) 4 Oth Proc CPT Mod MOD;0 130.164
146 . ; ^SRF(8,13,2,"MOD",1,0) .01 Oth Proc CPT Mod 0;1 Ptr 81.3
147 . ;
148 . I SRCPTM D
149 . . N SRJ S SRJ=0 F S SRJ=$O(^SRF(+($G(IEN)),13,SRI,"MOD",SRJ)) Q:+SRJ=0 D
150 . . . N DA,FILE,DIC,SUB,DR,DIQ S DA=IEN,DR=.42,FILE=130,SUB=130.16,DR(SUB)="4",DA(SUB)=SRI,SUB=130.164,DR(SUB)=".01",DA(SUB)=SRJ,DIC=130,DIQ="REC(130,"_IEN_",130.16,"_SRI_",",DIQ(0)="IE"
151 . . . D EN^DIQ1
152 . . . S SRM=+($G(REC(130,IEN,130.16,SRI,130.164,SRJ,.01,"I")))
153 . . . I SRM>0 N SRMOD1 D
154 . . . . S SRMOD1=$$MOD^ICPTMOD(+SRM,"I",$P($G(^SRF(IEN,0)),"^",9))
155 . . . . S SRC=$P(SRMOD1,"^",2)
156 . . . . S SRS=$P(SRMOD1,"^",3)
157 . . . . S REC(130,IEN,130.16,SRI,SUB,SRJ,.01,"MID")=SRC
158 . . . . S REC(130,IEN,130.16,SRI,SUB,SRJ,.01,"MOD")=SRS
159 . . . . S REC(130,IEN,130.16,SRI,SUB,SRJ,.01,"X")=SRC_"^"_SRS
160 . . . . S SRT=$$EN2^SROGMTS0(SRS) S:$L(SRC) SRT=SRT_" (CPT Mod "_SRC_")"
161 . . . . S REC(130,IEN,130.16,SRI,SUB,SRJ,.01,"S")=SRT
162 . . . K REC(130,IEN,130.16,SRI,130)
163 Q
164SG(X) ; Surgical (Operative) Record
165 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.