Changeset 623 for WorldVistAEHR/trunk/r/SURGERY-SR/SROGMTS.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROGMTS.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SURGERY-SR/SROGMTS.m
r613 r623 1 SROGMTS ;BIR/ADM - SURGERY HEALTH SUMMARY ; [ 08/08/01 7:12 AM ] 2 ;;3.0; Surgery ;**100,127,162**;24 Jun 93;Build 4 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 12 HS(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 CPT(SRM,$P($G(^SRF(IEN,0)),"^",9),130,27) 25 D DICT^SROGMTS0,SUB,SPD 26 S:$D(REC(130,IEN,32)) REC(130,IEN,32,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,32,"E"))) 27 S:$D(REC(130,IEN,33)) REC(130,IEN,33,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,33,"E"))) 28 S:$D(REC(130,IEN,34)) REC(130,IEN,34,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,34,"E"))) 29 S:$D(REC(130,IEN,.04)) REC(130,IEN,.04,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,.04,"E"))) 30 S:$D(REC(130,IEN,125)) REC(130,IEN,125,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,125,"E"))) 31 I $L($G(REC(130,IEN,33,"S"))) D 32 . S:'$L($G(REC(130,IEN,66,"E"))) REC(130,IEN,33,"S")=$G(REC(130,IEN,33,"S"))_" (Unknown)" 33 . 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"))_")" 34 S:+($G(REC(130,IEN,.09,"I")))>0 REC(130,IEN,.09,"S")=$$ED^SROGMTS0($G(REC(130,IEN,.09,"I"))) 35 S:+($G(REC(130,IEN,15,"I")))>0 REC(130,IEN,15,"S")=$$EDT^SROGMTS0($G(REC(130,IEN,15,"I"))) 36 S:+($G(REC(130,IEN,39,"I"))) REC(130,IEN,39,"S")=$$EDT^SROGMTS0($G(REC(130,IEN,39,"I"))) 37 S:+SRSG REC(130,IEN,"LAB")=$S($O(REC(130,IEN,49,0))>0:"Yes",1:"") 38 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) 39 Q 40 ED(X) ; external date 41 S X=$G(X) Q:'$L(X) "" 42 S X=$TR($$FMTE^XLFDT(X,"5DZ"),"@"," ") 43 Q X 44 EDT(X) ; external date and time 45 S X=$G(X) Q:'$L(X) "" 46 S X=$TR($$FMTE^XLFDT(X,"2ZM"),"@"," ") 47 Q X 48 WP(X,Y,Z) ; 49 N SRI,SRF,SRW,SRGI,DIWF,DIWL,DIWR 50 S SRI=+($G(X)) Q:SRI=0!('$D(REC(130,SRI))) 51 S SRF=+($G(Y)) Q:SRF=0!('$D(REC(130,SRI,SRF))) 52 S SRW=+($G(Z)) Q:SRW'>0!(SRW>79) 53 Q:+($O(REC(130,SRI,SRF,0)))'>0 54 K ^UTILITY($J,"W") S DIWF="C"_SRW,DIWL=0,DIWR=0,SRGI=0 55 F S SRGI=$O(REC(130,SRI,SRF,SRGI)) Q:+SRGI=0 D 56 . S X=$G(REC(130,SRI,SRF,SRGI)) 57 . D ^DIWP 58 S SRGI=0 F S SRGI=$O(^UTILITY($J,"W",0,SRGI)) Q:+SRGI=0 D 59 . S REC(130,SRI,SRF,"S",SRGI)=$G(^UTILITY($J,"W",0,SRGI,0)) 60 . S REC(130,SRI,SRF,"S",0)=$G(REC(130,SRI,SRF,"S",0))+1 61 K ^UTILITY($J,"W") 62 Q 63 OS(X) ; Obtains status for OR procedures 64 N SRN S SRN=+($G(X)) S X="" I $G(REC(130,SRN,118,"I"))="Y" D Q X 65 . S:+($G(REC(130,SRN,122,"I")))>0 X="(Completed)" 66 . S:+($G(REC(130,SRN,121,"I")))>0&(+($G(REC(130,SRN,122,"I")))'>0) X="Incomplete" 67 . S:X="" X="Unknown" 68 I +($G(REC(130,SRN,17,"I")))>0 D Q X 69 . S X=$S(+($G(REC(130,SRN,.205,"I")))>0:"(Aborted)",1:"Cancelled") 70 I +($G(REC(130,SRN,.23,"I")))>0 S X="(Completed)" Q X 71 I +($G(REC(130,SRN,.22,"I")))>0 S X="Incomplete" Q X 72 I +($G(REC(130,SRN,10,"I")))>0 S X="Scheduled" Q X 73 I +($G(REC(130,SRN,36,"I")))>0,+($G(REC(130,SRN,.22,"I")))'>0 S X="Requested" Q X 74 S X="Unknown" 75 Q X 76 SUB ; 77 N DA,DR,DIC,DIQ,IENS,FILE,FLD,FLDS,FLDI,FLDA,FLDB,FLDR,FLDRT,SRM,SRC,SRI,SRJ,STXT,SNAM,SCOD,SUB 78 I +SRSG D 79 . ; 80 . ; ^SRF(DO,14,I) .72 Other Preop Diag 14;0 130.17 81 . ; $P(^SRF(DO,14,I,0),U) .01 Other Preop Diag 0;1 Text 82 . ; 83 . S DA=IEN,(FILE,DIC)=130,SUB=130.17,DR=.72,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE" 84 . K REC(SUB) S SRI=0 F S SRI=$O(^SRF(+($G(IEN)),14,SRI)) Q:+SRI=0 D 85 . . S DA(SUB)=SRI 86 . . D EN^DIQ1 87 . . S REC(130,IEN,130.17,SRI,.01,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,130.17,SRI,.01,"E"))) 88 . ; 89 . ; ^SRF(DO,15,I) .74 Other Postop Diags 15;0 130.18 90 . ; $P(^SRF(DO,15,I,0),U) .01 Other Postop Diags 0;1 Text 91 . ; 92 . S DA=IEN,(FILE,DIC)=130,SUB=130.18,DR=.74,DR(SUB)=".01",DIQ="REC(130,"_IEN_",",DIQ(0)="IE" 93 . K REC(SUB) S SRI=0 F S SRI=$O(^SRF(+($G(IEN)),15,SRI)) Q:+SRI=0 D 94 . . S DA(SUB)=SRI 95 . . D EN^DIQ1 96 . . S REC(130,IEN,130.18,SRI,.01,"S")=$$EN2^SROGMTS0($G(REC(130,IEN,130.18,SRI,.01,"E"))) 97 ; 98 ; ^SRF(SRN,"OPMOD",I) 28 Pri Pro CPT Mod OPMOD;0 130.028 99 ; $P(^SRF(SRN,"OPMOD",I,0),U) .01 Pri Pro CPT Mod 0;1 Ptr 81.3 100 ; 101 I SRCPTM 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 SRI=0 F S SRI=$O(^SRF(+($G(IEN)),"OPMOD",SRI)) Q:+SRI=0 D 104 . . S DA(SUB)=SRI 105 . . D EN^DIQ1 106 . . S SRM=+($G(REC(130,+($G(IEN)),SUB,+($G(SRI)),.01,"I"))) I SRM>0 D MOD(SRM,FILE,SUB) 107 ; 108 ; ^SRF(DO,13,I) .42 Other Proc 13;0 130.16 109 ; $P(^SRF(DO,13,I,0),U) .01 Other Proc 0;1 Text 110 ; $P(^SRF(DO,13,I,2),U) 3 Other Proc CPT Code 2;1 Ptr 81 111 ; 112 S DA=IEN,(FILE,DIC)=130,SUB=130.16,DR=.42,DR(SUB)=".01;3",DIQ="REC(130,"_IEN_",",DIQ(0)="IE" 113 K REC(SUB) S SRI=0 F S SRI=$O(^SRF(+($G(IEN)),13,SRI)) Q:+SRI=0 D 114 . S DA(SUB)=SRI 115 . D EN^DIQ1 S SRM=+($G(REC(130,IEN,130.16,SRI,3,"I"))) 116 . S:SRM>0 REC(130,IEN,130.16,SRI,3,"N")=$P($$CPT^ICPTCOD(+SRM,$P($G(^SRF(IEN,0)),"^",9)),"^",3) 117 . N SRT,SRS,SRC S SRM=$G(REC(130,IEN,130.16,SRI,3,"I")) I SRM>0 D 118 . . S SRC=$$CPT^ICPTCOD(SRM,$P($G(^SRF(IEN,0)),"^",9)),(SRCS,SRS)=$$EN2^SROGMTS0($P(SRC,"^",3)) 119 . . S REC(130,IEN,130.16,SRI,3,"X")=$P(SRC,"^",2)_"^"_$P(SRC,"^",3) 120 . . S SRC=$P(SRC,"^",2) 121 . . S SRT=$$EN2^SROGMTS0($G(REC(130,IEN,130.16,SRI,.01,"E"))) 122 . . S:$L(SRS)&(SRS'=SRT) SRT=SRT_" - "_$$EN2^SROGMTS0(SRS) 123 . . S:$L(SRC)=5 SRT=SRT_" (CPT "_SRC_")",SRCS=SRCS_" (CPT "_SRC_")" 124 . . S REC(130,IEN,130.16,SRI,3,"N")=SRS 125 . . S REC(130,IEN,130.16,SRI,.01,"S")=SRT 126 . . S REC(130,IEN,130.16,SRI,3,"S")=SRCS 127 . ; 128 . ; ^SRF(8,13,2,"MOD",0) 4 Oth Proc CPT Mod MOD;0 130.164 129 . ; ^SRF(8,13,2,"MOD",1,0) .01 Oth Proc CPT Mod 0;1 Ptr 81.3 130 . ; 131 . I SRCPTM D 132 . . N SRJ S SRJ=0 F S SRJ=$O(^SRF(+($G(IEN)),13,SRI,"MOD",SRJ)) Q:+SRJ=0 D 133 . . . 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" 134 . . . D EN^DIQ1 135 . . . S SRM=+($G(REC(130,IEN,130.16,SRI,130.164,SRJ,.01,"I"))) 136 . . . I SRM>0 N SRMOD1 D 137 . . . . S SRMOD1=$$MOD^ICPTMOD(+SRM,"I",$P($G(^SRF(IEN,0)),"^",9)) 138 . . . . S SRC=$P(SRMOD1,"^",2) 139 . . . . S SRS=$P(SRMOD1,"^",3) 140 . . . . S REC(130,IEN,130.16,SRI,SUB,SRJ,.01,"MID")=SRC 141 . . . . S REC(130,IEN,130.16,SRI,SUB,SRJ,.01,"MOD")=SRS 142 . . . . S REC(130,IEN,130.16,SRI,SUB,SRJ,.01,"X")=SRC_"^"_SRS 143 . . . . S SRT=$$EN2^SROGMTS0(SRS) S:$L(SRC) SRT=SRT_" (CPT Mod "_SRC_")" 144 . . . . S REC(130,IEN,130.16,SRI,SUB,SRJ,.01,"S")=SRT 145 . . . K REC(130,IEN,130.16,SRI,130) 146 Q 147 SG(X) ; Surgical (Operative) Record 148 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 array 150 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_" - "_SRS 154 S:$L(SRC)=5 SRT=SRT_" (CPT "_SRC_")",SRCS=SRCS_" (CPT "_SRC_")" 155 S REC(SRFIL,IEN,SRFLD,"N")=SRS 156 S:SRFIL=130 REC(130,IEN,26,"S")=SRT 157 S REC(SRFIL,IEN,SRFLD,"S")=SRT 158 S REC(SRFIL,IEN,SRFLD,"S")=SRCS 159 Q 160 MOD(SRM,SRFIL,SUB) ;Set CPT Modifier into REC array 161 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")=SRC 165 S REC(SRFIL,IEN,SUB,SRI,.01,"MOD")=SRS 166 S SRT=$$EN2^SROGMTS0(SRS) 167 S:$L(SRC) SRT=SRT_" (CPT Mod "_SRC_")" 168 S REC(SRFIL,IEN,SUB,SRI,.01,"S")=SRT 169 Q 170 SPD ;Obtain Surgery Procedure/Diagnosis Code File entry 171 S (FILE,DIC)=136,DA=+($G(IEN)),DIQ="REC(",DIQ(0)="IE" 172 S DR=".01;.02;.03;10" 173 D EN^DIQ1 174 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 D 179 .S DA(SUB)=SRI 180 .D EN^DIQ1 181 .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 D 184 . S DA(SUB)=SRI 185 . D EN^DIQ1 186 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 1 SROGMTS ;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 12 HS(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 48 ED(X) ; external date 49 S X=$G(X) Q:'$L(X) "" 50 S X=$TR($$FMTE^XLFDT(X,"5DZ"),"@"," ") 51 Q X 52 EDT(X) ; external date and time 53 S X=$G(X) Q:'$L(X) "" 54 S X=$TR($$FMTE^XLFDT(X,"2ZM"),"@"," ") 55 Q X 56 WP(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 71 OS(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 84 SUB ; 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 164 SG(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 TracChangeset
for help on using the changeset viewer.
