Changeset 636 for FOIAVistA/tag/r/SURGERY-SR/SROGMTS.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/SURGERY-SR/SROGMTS.m
r628 r636 1 1 SROGMTS ;BIR/ADM - SURGERY HEALTH SUMMARY ; [ 08/08/01 7:12 AM ] 2 ;;3.0; Surgery ;**100,127 ,162**;24 Jun 93;Build 42 ;;3.0; Surgery ;**100,127**;24 Jun 93 3 3 ; 4 4 ;** NOTICE: This routine is part of an implementation of a nationally … … 22 22 S:'SRSG DR=".09;.31;26;27;33;50;55;59;66;121;122;123;124;125" 23 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 CPT(SRM,$P($G(^SRF(IEN,0)),"^",9),130,27) 25 D DICT^SROGMTS0,SUB,SPD 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 26 34 S:$D(REC(130,IEN,32)) REC(130,IEN,32,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,32,"E"))) 27 35 S:$D(REC(130,IEN,33)) REC(130,IEN,33,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,33,"E"))) … … 104 112 . . S DA(SUB)=SRI 105 113 . . D EN^DIQ1 106 . . S SRM=+($G(REC(130,+($G(IEN)),SUB,+($G(SRI)),.01,"I"))) I SRM>0 D MOD(SRM,FILE,SUB) 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 107 124 ; 108 125 ; ^SRF(DO,13,I) .42 Other Proc 13;0 130.16 … … 147 164 SG(X) ; Surgical (Operative) Record 148 165 S X=$$GET1^DIQ(130,+($G(X)),118,"I") S X=$S(X["Y":0,1:1) Q X 149 CPT(SRM,SRDOO,SRFIL,SRFLD) ;Set CPT code into REC array150 S SRC=$$CPT^ICPTCOD(SRM,SRDOO),(SRCS,SRS)=$$EN2^SROGMTS0($P(SRC,"^",3))151 S REC(SRFIL,IEN,SRFLD,"X")=$P(SRC,"^",2)_"^"_$P(SRC,"^",3)152 S SRC=$P(SRC,"^",2),SRT=$$EN2^SROGMTS0($G(REC(130,IEN,26,"E")))153 S:$L(SRS)&(SRS'=SRT) SRT=SRT_" - "_SRS154 S:$L(SRC)=5 SRT=SRT_" (CPT "_SRC_")",SRCS=SRCS_" (CPT "_SRC_")"155 S REC(SRFIL,IEN,SRFLD,"N")=SRS156 S:SRFIL=130 REC(130,IEN,26,"S")=SRT157 S REC(SRFIL,IEN,SRFLD,"S")=SRT158 S REC(SRFIL,IEN,SRFLD,"S")=SRCS159 Q160 MOD(SRM,SRFIL,SUB) ;Set CPT Modifier into REC array161 S SRMOD=$$MOD^ICPTMOD(+SRM,"I",$P($G(^SRF(IEN,0)),"^",9))162 S SRC=$P(SRMOD,"^",2)163 S SRS=$P(SRMOD,"^",3)164 S REC(SRFIL,IEN,SUB,SRI,.01,"MID")=SRC165 S REC(SRFIL,IEN,SUB,SRI,.01,"MOD")=SRS166 S SRT=$$EN2^SROGMTS0(SRS)167 S:$L(SRC) SRT=SRT_" (CPT Mod "_SRC_")"168 S REC(SRFIL,IEN,SUB,SRI,.01,"S")=SRT169 Q170 SPD ;Obtain Surgery Procedure/Diagnosis Code File entry171 S (FILE,DIC)=136,DA=+($G(IEN)),DIQ="REC(",DIQ(0)="IE"172 S DR=".01;.02;.03;10"173 D EN^DIQ1174 Q:'+$G(REC(FILE,IEN,10,"I"))175 S SRM=+$G(REC(FILE,IEN,.02,"I"))176 Q:'(SRM>0) D CPT(SRM,$P($G(^SRF(IEN,0)),"^",9),FILE,.02)177 S SUB=136.01,DR=1,DR(SUB)=".01",DIQ="REC(136,"_IEN_","178 K REC(FILE,IEN,SUB) S SRI=0 F S SRI=$O(^SRO(FILE,(+$G(IEN)),DR,SRI)) Q:+SRI=0 D179 .S DA(SUB)=SRI180 .D EN^DIQ1181 .S SRM=REC(FILE,IEN,SUB,SRI,.01,"I") I SRM>0 D MOD(SRM,FILE,SUB)182 N DA S DA=IEN,SUB=136.011,DR=11,DR(SUB)=".01;1"183 K REC(FILE,IEN,SUB) S SRI=0 F S SRI=$O(^SRO(FILE,(+$G(IEN)),DR,SRI)) Q:+SRI=0 D184 . S DA(SUB)=SRI185 . D EN^DIQ1186 S $P(REC(130,IEN,26,"S"),"-",2)=" "_REC(FILE,IEN,.02,"S")187 K REC(130,IEN,130.028) M REC(130,IEN,130.028)=REC(FILE,IEN,136.01)188 Q
Note:
See TracChangeset
for help on using the changeset viewer.