Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXSURG.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXSURG.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXSURG.m
r613 r623 1 ECXSURG ;ALB/JA,BIR/DMA,PTD-Surgery Extract for DSS ; 11/20/07 8:13am 2 ;;3.0;DSS EXTRACTS;**1,11,8,13,25,24,33,39,41,42,46,50,71,84,92,99,105**;Dec 22, 1997;Build 70 3 BEG ;entry point from option 4 D SETUP I ECFILE="" Q 5 D ^ECXTRAC,^ECXKILL 6 Q 7 ; 8 START ; 9 S QFLG=0,ECED=ECED+.3,ECD=ECSD1 10 F S ECD=$O(^SRF("AC",ECD)),ECD0=0 Q:('ECD)!(ECD>ECED)!(QFLG) D 11 .F S ECD0=$O(^SRF("AC",ECD,ECD0)) Q:'ECD0 D 12 ..I $D(^SRF(ECD0,0)) S EC=^SRF(ECD0,0),ECXDFN=+$P(EC,U),ECXVISIT=$P(EC,U,15) D STUFF Q:QFLG 13 Q 14 ; 15 STUFF ;gather data 16 N J,X,Y,PP,DATA1,DATA2,DATAOP,ARR,ERR,SUB,MOD,ECXNONL,ECXSTOP,TIMEDIF 17 N ECPRO,ECXORCT,ECXPTHA,ECXNPRFI,ECXPA,ECXPAPC,ECSRPC,ECATPC,ECSAPC 18 N ECXCRST,ECXSTCD,ECXCLIN 19 S ECXDATE=ECD,ECXERR=0,ECXQ="" 20 Q:'$$PATDEM^ECXUTL2(ECXDFN,ECXDATE,"1;2;3;5;") 21 I ECXADMDT="" S ECXADD=ECXADMDT 22 I ECXADMDT'="" S ECXADD=$$ECXDATE^ECXUTL(ECXADMDT,ECXYM) 23 S OK=$$PAT^ECXUTL3(ECXDFN,ECXDATE,"1;5",.ECXPAT) 24 I 'OK S ECXERR=1 K ECXPAT Q 25 ;OEF/OIF DATA 26 S ECXOEF=ECXPAT("ECXOEF") 27 S ECXOEFDT=ECXPAT("ECXOEFDT") 28 S EC0=^SRF(ECD0,0) 29 S DATA1=$S($D(^SRF(ECD0,.1)):^(.1),1:"") 30 S DATA2=$S($D(^SRF(ECD0,.2)):^(.2),1:"") 31 S DATAOP=$S($D(^SRO(136,ECD0,0)):^(0),1:"") 32 S ECNO=$G(^SRF(ECD0,"NON")) 33 ;get data 34 S ECSR=$P(DATA1,U,4),(ECATNPI,ECSANPI,ECSRNPI)="",ECAT=$P(DATA1,U,13) 35 S ECSRNPI=$$NPI^XUSNPI("Individual_ID",ECSR,ECXDATE) 36 S:+ECSRNPI'>0 ECSRNPI="" S ECSRNPI=$P(ECSRNPI,U) 37 ;-Time patient in OR room (Nurse Time) 38 S ECXTM=$$ECXTIME^ECXUTL($P(DATA2,U,10)) 39 S ECXDIV=$S($D(^SRF(ECD0,8)):^(8),1:ECINST) 40 N ECXPDIV S ECXPDIV=$$RADDIV^ECXDEPT(ECXDIV) ;Production Division 41 S ECSA=$P($G(^SRF(ECD0,.3)),U,4),ECO=$P(EC0,U,2) 42 S ECSANPI=$$NPI^XUSNPI("Individual_ID",ECSA,ECXDATE) 43 S:+ECSANPI'>0 ECSANPI="" S ECSANPI=$P(ECSANPI,U) 44 ;get principle anesthetist and person class DBIA #103 45 S ECXPA=$P($G(^SRF(ECD0,.3)),U,1) 46 S ECPANPI=$$NPI^XUSNPI("Individual_ID",ECXPA,ECXDATE) 47 S:+ECPANPI'>0 ECPANPI="" S ECPANPI=$P(ECPANPI,U) 48 S ECXPAPC=$$PRVCLASS^ECXUTL(ECXPA,ECXDATE) 49 S ECORTY=$P($G(^SRS(+ECO,2)),U),ECO=$P($G(^SRS(+ECO,0)),U) 50 S ECSS=$P($G(^SRO(137.45,+$P(EC0,U,4),0)),U,2) 51 S ECSS=$$RJ^XLFSTR($P($G(^DIC(45.3,+ECSS,0)),U),3,0) 52 S:ECSS="000" ECSS="999" 53 ;get classification information 54 S (ECXAO,ECXHNC)="" I ECXVISIT'="" D 55 .D VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR) I ECXERR K ECXERR 56 .S ECXAO=$G(ECXVIST("AO")),ECXHNC=$G(ECXVIST("HNC")) 57 ; - Head and Neck Cancer Indicator 58 S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN) 59 ;look for non-OR 60 S (ECNT,ECNL,ECXDSSD,ECXNONL,ECXSTOP)="" 61 I $P(ECNO,U)="Y" D 62 .S ECSR=$P(ECNO,U,6),ECAT=$P(ECNO,U,7) 63 .S ECSRNPI=$$NPI^XUSNPI("Individual_ID",ECSR,ECXDATE) 64 .S:+ECSRNPI'>0 ECSRNPI="" S ECSRNPI=$P(ECSRNPI,U) 65 .S ECATNPI=$$NPI^XUSNPI("Individual_ID",ECAT,ECXDATE) 66 .S:+ECATNPI'>0 ECATNPI="" S ECATNPI=$P(ECATNPI,U) 67 .S ECXTM=$$ECXTIME^ECXUTL($P(ECNO,U,4)) 68 .S A1=$P(ECNO,U,5),A2=$P(ECNO,U,4),TIME="##" D:(A1&A2) TIME S ECNT=TIME 69 .S (ECXNONL,ECNL)=+$P(ECNO,U,2),ECNL=$P($G(^ECX(728.44,ECNL,0)),U,9) 70 .S:ECNL="" ECNL="UNKNOWN" 71 .; 72 .;- Get DSS Stop Code to use in encounter number 73 .S ECXSTOP=$P($G(^ECX(728.44,ECXNONL,0)),U,4) 74 ; 75 ;- Get credit stop, stop code and clinic 76 I $$SUR^ECXUTL6(.ECXCRST,.ECXSTCD,.ECXCLIN) 77 ; 78 ;- If surgery cancelled/aborted quit and go to next record 79 S ECCAN=$P($G(^SRF(ECD0,30)),U) 80 I +ECCAN S ECCAN=$$CANC^ECXUTL4(ECNL,$P(DATA2,U,10)) 81 ;on hold for ECXDSSD and ECXDSSP I $P($G(^SRF(ECD0,30)),U) Q 82 ;get service of attending surgeon 83 S ECATSV=$P($G(^DIC(49,+$G(^VA(200,+ECAT,5)),730)),U) 84 ; 85 ;get surgeon, attending and anesthesia super person classes 86 S ECSRPC=$$PRVCLASS^ECXUTL(ECSR,ECXDATE) 87 S ECATPC=$$PRVCLASS^ECXUTL(ECAT,ECXDATE) 88 S ECSAPC=$$PRVCLASS^ECXUTL(ECSA,ECXDATE) 89 ; 90 ;add leading 2s for pointer to 200 91 S:ECAT ECAT="2"_ECAT S:ECSR ECSR="2"_ECSR S:ECSA ECSA="2"_ECSA 92 ;add leading 2 to principle anesthetist IEN 93 S:ECXPA ECXPA="2"_ECXPA 94 ;anesthesia technique 95 S ECANE="",PP="" 96 I $D(^SRF(ECD0,6,0)) S ECXJ=0 D 97 .F S ECXJ=$O(^SRF(ECD0,6,ECXJ)) Q:('ECXJ)!(ECANE]"") D 98 ..S PP=$P($G(^(ECXJ,0)),U,3) S:PP="Y" ECANE=$P(^(0),U,1) 99 .I ECANE="" S ECXJ=$O(^SRF(ECD0,6,0)) I ECXJ S ECANE=$P(^SRF(ECD0,6,ECXJ,0),U,1) 100 ;get primary procedure 101 ;ecode0=p^cpt code^^patient time^operation time^anesthesia time 102 S ECPT=+$P(DATAOP,U,2),ECXCMOD="" 103 K ARR,ERR D FIELD^DID(130,28,,"LABEL","ARR","ERR") I $D(ARR("LABEL")) D 104 .K ARR,ERR D FIELD^DID(130,28,,"GLOBAL SUBSCRIPT LOCATION","ARR","ERR") 105 .Q:$D(ERR("DIERR")) 106 .S SUB=$P(ARR("GLOBAL SUBSCRIPT LOCATION"),";"),MOD=0 107 .F S MOD=$O(^SRF(ECD0,SUB,MOD)) Q:MOD'>0 D 108 ..S ECXCMOD=ECXCMOD_$P(^(MOD,0),U)_";" 109 S ECXCPT=$$CPT^ECXUTL3(ECPT,ECXCMOD) 110 S ECODE0="P"_U_U ;ECPT_U 111 F J="10,12","2,3","1,4" D 112 .N ECNTIME,ECSTIME,ECATIME 113 .S A2=$P(DATA2,U,$P(J,",")),A1=$P(DATA2,U,$P(J,",",2)),TIME="##" 114 .I (A1&A2)&(+J=10) D TIME S ECNTIME=TIME 115 .I (A1&A2)&(+J=1) D TIME S ECATIME=TIME 116 .I (A1&A2)&(+J=2) D 117 ..; 118 ..;-Operation Time (Surgeon Time) 119 ..;-Get time diff (in secs) & set to .5 if < 7.5 minutes (rounds to 1) 120 ..S TIMEDIF=$$FMDIFF^XLFDT(A1,A2,2)/900 121 ..S TIMEDIF=$S(TIMEDIF>0&(TIMEDIF<.5):.5,1:TIMEDIF) 122 ..S TIME=$TR($J(TIMEDIF,4,0)," ") 123 ..S:TIME<0 TIME="###" 124 ..S:TIME ECSTIME=TIME 125 .S ECODE0=ECODE0_U_TIME K TIME 126 ; -Recovery Room Time 127 S ECRR="" 128 I $D(^SRF(ECD0,1.1)) D 129 .S A1=$P(^(1.1),U,8),A2=$P(^(1.1),U,7),TIME="##" D:(A1&A2) TIME 130 .S ECRR=TIME K TIME 131 I ECNL]"" S $P(ECODE0,U,5)=ECNT 132 ; 133 ; -OR Clean Time in 15 min increments DBIA #103 134 S ECXORCT=($$FMDIFF^XLFDT($P($G(DATA2),U,14),$P($G(DATA2),U,13),2)/60)/15 135 ; -If no OR clean time recorded set it to 2 136 I ECXORCT'>0 S ECXORCT=2 137 ; 138 ; -PT in hold area time in 15 min increments DBIA #103 139 I $P($G(DATA2),U,10),$P($G(DATA2),U,15) D 140 .S ECXPTHA=($$FMDIFF^XLFDT($P($G(DATA2),U,10),$P($G(DATA2),U,15),2)/60)/15 141 .S CON=$P($G(^SRF(ECD0,"CON")),U) 142 .I CON S ECXPTHA=ECXPTHA/2 143 .S ECXPTHA=$TR($J(ECXPTHA,3,0)," ") 144 ; -If hold time is =<0 set it to "" 145 S:$G(ECXPTHA)'>0 ECXPTHA="" 146 ; 147 ;- Observation Patient Indicator (yes/no) 148 S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECNL) 149 ; 150 ;- set national patient record flag if exist 151 D NPRF^ECXUTL5 152 ; 153 ;- If no encounter number don't file record 154 S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXSTOP,ECSS) Q:ECXENC="" 155 ; 156 ;- Get postop diagnosis codes 157 I $$SURPODX^ECXUTL6(.ECXPODX,.ECXPODX1,.ECXPODX2,.ECXPODX3,.ECXPODX4,.ECXPODX5) 158 ; 159 D FILE^ECXSURG1 160 ;get secondary procedures 161 ;ecode0=s^cpt code 162 S ECXJ=0 163 F S ECXJ=$O(^SRO(136,ECD0,3,ECXJ)) Q:'ECXJ I $D(^(ECXJ,0)),$D(^(0)),$P(^(0),"^")]"" D 164 .;S ECPT=$P(^SRF(ECD0,13,ECXJ,2),U),ECXCMOD="" 165 .S ECPT=$P(^SRO(136,ECD0,3,ECXJ,0),U),ECXMOD="" 166 .S ECPT=$P(^(0),"^"),ECXCMOD="" 167 .K ARR,ERR 168 .D FIELD^DID(130.16,4,,"LABEL","ARR","ERR") I $D(ARR("LABEL")) D 169 ..K ARR,ERR 170 ..D FIELD^DID(130.16,4,,"GLOBAL SUBSCRIPT LOCATION","ARR","ERR") 171 ..Q:$D(ERR("DIERR")) 172 ..S SUB=$P(ARR("GLOBAL SUBSCRIPT LOCATION"),";"),MOD=0 173 ..F S MOD=$O(^SRF(ECD0,13,ECXJ,SUB,MOD)) Q:MOD'>0 S ECXCMOD=ECXCMOD_$P(^(MOD,0),U)_";" 174 .S ECXCPT=$$CPT^ECXUTL3(ECPT,ECXCMOD) 175 .S ECODE0="S"_U ;_ECPT 176 .D FILE^ECXSURG1 177 ;get prostheses 178 ;ecode0=i^^^^^^prosthesis^old qty field (null) 179 S ECXJ=0 180 F S ECXJ=$O(^SRF(ECD0,1,ECXJ)) Q:'ECXJ I $D(^(ECXJ,0)) D 181 .S ECXP=+^SRF(ECD0,1,ECXJ,0),ECXQ=$P($G(^(1)),U,2) S:'ECXQ ECXQ=1 182 .S ECODE0="I"_U_U_U_U_U_U_ECXP_U_U 183 .D FILE^ECXSURG1 184 Q 185 ; 186 ; 187 TIME ; given date/time get increment 188 ;A1=later, A2=earlier, TIME=difference 189 N CON,TIMEDIF 190 S CON=$P($G(^SRF(ECD0,"CON")),U) 191 ; 192 ;-Get time diff (in secs) & set to .5 if < 7.5 minutes (rounds to 1) 193 S TIMEDIF=$$FMDIFF^XLFDT(A1,A2,2)/900 194 S TIMEDIF=$S(TIMEDIF>0&(TIMEDIF<.5):.5,1:TIMEDIF) 195 I 'CON D 196 .S TIME=$J($TR($J(TIMEDIF,4,0)," "),2,1) 197 .S:TIME>"99.0" TIME="99.0" 198 I CON D 199 .S TIME=$J(($TR($J(TIMEDIF,4,0)," ")/2),2,1) 200 .S:TIME>"99.5" TIME="99.5" 201 S:TIME<0 TIME="###" 202 Q 203 ; 204 SETUP ;Set required input for ECXTRAC 205 S ECHEAD="SUR" 206 D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER) 207 Q 208 ; 209 QUE ; entry point for the background requeuing handled by ECXTAUTO 210 D SETUP,QUE^ECXTAUTO,^ECXKILL Q 1 ECXSURG ;ALB/JA,BIR/DMA,PTD-Surgery Extract for DSS ; 11/2/06 9:00am 2 ;;3.0;DSS EXTRACTS;**1,11,8,13,25,24,33,39,41,42,46,50,71,84,92,99**;Dec 22, 1997;Build 2 3 BEG ;entry point from option 4 D SETUP I ECFILE="" Q 5 D ^ECXTRAC,^ECXKILL 6 Q 7 ; 8 START ; 9 S QFLG=0,ECED=ECED+.3,ECD=ECSD1 10 F S ECD=$O(^SRF("AC",ECD)),ECD0=0 Q:('ECD)!(ECD>ECED)!(QFLG) D 11 .F S ECD0=$O(^SRF("AC",ECD,ECD0)) Q:'ECD0 D 12 ..I $D(^SRF(ECD0,0)) S EC=^SRF(ECD0,0),ECXDFN=+$P(EC,U),ECXVISIT=$P(EC,U,15) D STUFF Q:QFLG 13 Q 14 ; 15 STUFF ;gather data 16 N J,X,Y,PP,DATA1,DATA2,DATAOP,ARR,ERR,SUB,MOD,ECXNONL,ECXSTOP,TIMEDIF 17 N ECPRO,ECXORCT,ECXPTHA,ECXNPRFI,ECXPA,ECXPAPC,ECSRPC,ECATPC,ECSAPC 18 S ECXDATE=ECD,ECXERR=0,ECXQ="" 19 Q:'$$PATDEM^ECXUTL2(ECXDFN,ECXDATE,"1;2;3;5;") 20 I ECXADMDT="" S ECXADD=ECXADMDT 21 I ECXADMDT'="" S ECXADD=$$ECXDATE^ECXUTL(ECXADMDT,ECXYM) 22 S EC0=^SRF(ECD0,0) 23 S DATA1=$S($D(^SRF(ECD0,.1)):^(.1),1:"") 24 S DATA2=$S($D(^SRF(ECD0,.2)):^(.2),1:"") 25 ;S DATAOP=$S($D(^SRF(ECD0,"OP")):^("OP"),1:"") 26 S DATAOP=$S($D(^SRO(136,ECD0,0)):^(0),1:"") 27 S ECNO=$G(^SRF(ECD0,"NON")) 28 ;get data 29 S ECSR=$P(DATA1,U,4),(ECATNPI,ECSANPI,ECSRNPI)="",ECAT=$P(DATA1,U,13) 30 ;-Time patient in OR room (Nurse Time) 31 S ECXTM=$$ECXTIME^ECXUTL($P(DATA2,U,10)) 32 S ECXDIV=$S($D(^SRF(ECD0,8)):^(8),1:ECINST) 33 N ECXPDIV S ECXPDIV=$$RADDIV^ECXDEPT(ECXDIV) ;Production Division 34 S ECSA=$P($G(^SRF(ECD0,.3)),U,4),ECO=$P(EC0,U,2) 35 ;get principle anesthetist and person class DBIA #103 36 S ECXPA=$P($G(^SRF(ECD0,.3)),U,1) 37 S ECXPAPC=$$PRVCLASS^ECXUTL(ECXPA,ECXDATE) 38 S ECORTY=$P($G(^SRS(+ECO,2)),U),ECO=$P($G(^SRS(+ECO,0)),U) 39 S ECSS=$P($G(^SRO(137.45,+$P(EC0,U,4),0)),U,2) 40 S ECSS=$$RJ^XLFSTR($P($G(^DIC(45.3,+ECSS,0)),U),3,0) 41 S:ECSS="000" ECSS="999" 42 ;get classification information 43 S (ECXAO,ECXHNC)="" I ECXVISIT'="" D 44 .D VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR) I ECXERR K ECXERR 45 .S ECXAO=$G(ECXVIST("AO")),ECXHNC=$G(ECXVIST("HNC")) 46 ; - Head and Neck Cancer Indicator 47 S ECXHNCI=$$HNCI^ECXUTL4(ECXDFN) 48 ;look for non-OR 49 S (ECNT,ECNL,ECXDSSD,ECXNONL,ECXSTOP)="" 50 I $P(ECNO,U)="Y" D 51 .S ECSR=$P(ECNO,U,6),ECAT=$P(ECNO,U,7) 52 .S ECXTM=$$ECXTIME^ECXUTL($P(ECNO,U,4)) 53 .S A1=$P(ECNO,U,5),A2=$P(ECNO,U,4),TIME="##" D:(A1&A2) TIME S ECNT=TIME 54 .S (ECXNONL,ECNL)=+$P(ECNO,U,2),ECNL=$P($G(^ECX(728.44,ECNL,0)),U,9) 55 .S:ECNL="" ECNL="UNKNOWN" 56 .; 57 .;- Get DSS Stop Code to use in encounter number 58 .S ECXSTOP=$P($G(^ECX(728.44,ECXNONL,0)),U,4) 59 ; 60 ;- If surgery cancelled/aborted quit and go to next record 61 S ECCAN=$P($G(^SRF(ECD0,30)),U) 62 I +ECCAN S ECCAN=$$CANC^ECXUTL4(ECNL,$P(DATA2,U,10)) 63 ;on hold for ECXDSSD and ECXDSSP I $P($G(^SRF(ECD0,30)),U) Q 64 ;get service of attending surgeon 65 S ECATSV=$P($G(^DIC(49,+$G(^VA(200,+ECAT,5)),730)),U) 66 ; 67 ;get surgeon, attending and anesthesia super person classes 68 S ECSRPC=$$PRVCLASS^ECXUTL(ECSR,ECXDATE) 69 S ECATPC=$$PRVCLASS^ECXUTL(ECAT,ECXDATE) 70 S ECSAPC=$$PRVCLASS^ECXUTL(ECSA,ECXDATE) 71 ; 72 ;add leading 2s for pointer to 200 73 S:ECAT ECAT="2"_ECAT S:ECSR ECSR="2"_ECSR S:ECSA ECSA="2"_ECSA 74 ;add leading 2 to principle anesthetist IEN 75 S:ECXPA ECXPA="2"_ECXPA 76 ;anesthesia technique 77 S ECANE="",PP="" 78 I $D(^SRF(ECD0,6,0)) S ECXJ=0 D 79 .F S ECXJ=$O(^SRF(ECD0,6,ECXJ)) Q:('ECXJ)!(ECANE]"") D 80 ..S PP=$P($G(^(ECXJ,0)),U,3) S:PP="Y" ECANE=$P(^(0),U,1) 81 .I ECANE="" S ECXJ=$O(^SRF(ECD0,6,0)) I ECXJ S ECANE=$P(^SRF(ECD0,6,ECXJ,0),U,1) 82 ;get primary procedure 83 ;ecode0=p^cpt code^^patient time^operation time^anesthesia time 84 S ECPT=+$P(DATAOP,U,2),ECXCMOD="" 85 K ARR,ERR D FIELD^DID(130,28,,"LABEL","ARR","ERR") I $D(ARR("LABEL")) D 86 .K ARR,ERR D FIELD^DID(130,28,,"GLOBAL SUBSCRIPT LOCATION","ARR","ERR") 87 .Q:$D(ERR("DIERR")) 88 .S SUB=$P(ARR("GLOBAL SUBSCRIPT LOCATION"),";"),MOD=0 89 .F S MOD=$O(^SRF(ECD0,SUB,MOD)) Q:MOD'>0 D 90 ..S ECXCMOD=ECXCMOD_$P(^(MOD,0),U)_";" 91 S ECXCPT=$$CPT^ECXUTL3(ECPT,ECXCMOD) 92 S ECODE0="P"_U_U ;ECPT_U 93 F J="10,12","2,3","1,4" D 94 .N ECNTIME,ECSTIME,ECATIME 95 .S A2=$P(DATA2,U,$P(J,",")),A1=$P(DATA2,U,$P(J,",",2)),TIME="##" 96 .I (A1&A2)&(+J=10) D TIME S ECNTIME=TIME 97 .I (A1&A2)&(+J=1) D TIME S ECATIME=TIME 98 .I (A1&A2)&(+J=2) D 99 ..; 100 ..;-Operation Time (Surgeon Time) 101 ..;-Get time diff (in secs) & set to .5 if < 7.5 minutes (rounds to 1) 102 ..S TIMEDIF=$$FMDIFF^XLFDT(A1,A2,2)/900 103 ..S TIMEDIF=$S(TIMEDIF>0&(TIMEDIF<.5):.5,1:TIMEDIF) 104 ..S TIME=$TR($J(TIMEDIF,4,0)," ") 105 ..S:TIME<0 TIME="###" 106 ..S:TIME ECSTIME=TIME 107 .S ECODE0=ECODE0_U_TIME K TIME 108 ; -Recovery Room Time 109 S ECRR="" 110 I $D(^SRF(ECD0,1.1)) D 111 .S A1=$P(^(1.1),U,8),A2=$P(^(1.1),U,7),TIME="##" D:(A1&A2) TIME 112 .S ECRR=TIME K TIME 113 I ECNL]"" S $P(ECODE0,U,5)=ECNT 114 ; 115 ; -OR Clean Time in 15 min increments DBIA #103 116 S ECXORCT=($$FMDIFF^XLFDT($P($G(DATA2),U,14),$P($G(DATA2),U,13),2)/60)/15 117 ; -If no OR clean time recorded set it to 2 118 I ECXORCT'>0 S ECXORCT=2 119 ; 120 ; -PT in hold area time in 15 min increments DBIA #103 121 I $P($G(DATA2),U,10),$P($G(DATA2),U,15) D 122 .S ECXPTHA=($$FMDIFF^XLFDT($P($G(DATA2),U,10),$P($G(DATA2),U,15),2)/60)/15 123 .S CON=$P($G(^SRF(ECD0,"CON")),U) 124 .I CON S ECXPTHA=ECXPTHA/2 125 .S ECXPTHA=$TR($J(ECXPTHA,3,0)," ") 126 ; -If hold time is =<0 set it to "" 127 S:$G(ECXPTHA)'>0 ECXPTHA="" 128 ; 129 ;- Observation Patient Indicator (yes/no) 130 S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECNL) 131 ; 132 ;- set national patient record flag if exist 133 D NPRF^ECXUTL5 134 ; 135 ;- If no encounter number don't file record 136 S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXSTOP,ECSS) Q:ECXENC="" 137 ; 138 D FILE 139 ;get secondary procedures 140 ;ecode0=s^cpt code 141 S ECXJ=0 142 ;F S ECXJ=$O(^SRF(ECD0,13,ECXJ)) Q:'ECXJ I $D(^(ECXJ,0)),$D(^(2)),$P(^(2),U)]"" D 143 F S ECXJ=$O(^SRO(136,ECD0,3,ECXJ)) Q:'ECXJ I $D(^(ECXJ,0)),$D(^(0)),$P(^(0),"^")]"" D 144 .;S ECPT=$P(^SRF(ECD0,13,ECXJ,2),U),ECXCMOD="" 145 . S ECPT=$P(^SRO(136,ECD0,3,ECXJ,0),"^"),ECXCMOD="" 146 .K ARR,ERR 147 .D FIELD^DID(130.16,4,,"LABEL","ARR","ERR") I $D(ARR("LABEL")) D 148 ..K ARR,ERR 149 ..D FIELD^DID(130.16,4,,"GLOBAL SUBSCRIPT LOCATION","ARR","ERR") 150 ..Q:$D(ERR("DIERR")) 151 ..S SUB=$P(ARR("GLOBAL SUBSCRIPT LOCATION"),";"),MOD=0 152 ..F S MOD=$O(^SRF(ECD0,13,ECXJ,SUB,MOD)) Q:MOD'>0 S ECXCMOD=ECXCMOD_$P(^(MOD,0),U)_";" 153 .S ECXCPT=$$CPT^ECXUTL3(ECPT,ECXCMOD) 154 .S ECODE0="S"_U ;_ECPT 155 .D FILE 156 ;get prostheses 157 ;ecode0=i^^^^^^prosthesis^old qty field (null) 158 S ECXJ=0 159 F S ECXJ=$O(^SRF(ECD0,1,ECXJ)) Q:'ECXJ I $D(^(ECXJ,0)) D 160 .S ECXP=+^SRF(ECD0,1,ECXJ,0),ECXQ=$P($G(^(1)),U,2) S:'ECXQ ECXQ=1 161 .S ECODE0="I"_U_U_U_U_U_U_ECXP_U_U 162 .D FILE 163 Q 164 ; 165 FILE ;file record 166 ;node0 167 ;division^dfn^ssn^name^in/out (ECXA)^day^case #^ 168 ;surg specialty^or room #^ 169 ;surgeon^attending^anesthesia supervisor^anesthesia technique^ 170 ;primary/secondary/prostheses^cpt^^pt time^op time^anes time^ 171 ;prostheses^qty^^ 172 ;movement number^treating specialty^cancel/abort (ECCAN)^time^or type^ 173 ;attending's service^non-or dss id^recovery room time^^ 174 ;primary care team^primary care provider^admission date 175 ;node1 176 ;mpi^dss dept ECXDSSD^surgeon npi^attending npi^anes supervisor npi^ 177 ;pc provider npi^pc prov person class^ 178 ;assoc pc provider^assoc pc prov person class^assoc pc prov npi^ 179 ;cpt&modifiers ECXCPT^dom ECXDOM^enrollment category ECXCAT^ 180 ;enrollment status ECXSTAT^enrollment priority ECXPRIOR^ 181 ;period of service ECXPOS^purple heart indicator ECXPHI^ 182 ;observ pat ind ECXOBS^encounter num ECXENC^ao loc ECXAOL^ 183 ;production division ECXPDIV^head & neck canc ind ECXHNCI^ 184 ;ethnicity ECXETH^race1 ECXRC1^new quantity ECXQ^ 185 ;^user enrollee ECXUESTA^patient type ECXPTYPE^combat vet elig 186 ;ECXCVE^combat vet elig end date ECXCVEDT^enc cv eligible ECXCVENC 187 ;or clean time ECXORCT^time pt in hold area ECXPTHA^national patient 188 ;record flag ECXNPRFI^princ anesthetist ECXPA^surgeon per class ECSRPC 189 ;node2 190 ;atten surgeon per class ECATPC^anesthesia super person class ECSAPC^ 191 ;princ anesthetist PC ECXPAPC^emergency response indicator(FEMA) ECXERI^ 192 ;agent orange indic ECXAO^head/neck cancer ECXHNC 193 ; 194 N DA,DIK,STR 195 S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1 196 S ECODE=EC7_U_EC23_U_ECXDIV_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U 197 S ECODE=ECODE_$$ECXDATE^ECXUTL(ECXDATE,ECXYM)_U_ECD0_U_ECSS_U_ECO_U 198 S ECODE=ECODE_ECSR_U_ECAT_U_ECSA_U_ECANE_U_ECODE0_U 199 S STR=ECXMN_U_ECXTS_U_$S(ECCAN'="":ECCAN,1:"")_U_ECXTM_U_ECORTY_U 200 S STR=STR_ECATSV_U_ECNL_U_ECRR_U_U_ECPTTM_U_ECPTPR_U_ECXADD_U 201 S $P(ECODE,U,26,38)=STR 202 S ECODE1=ECXMPI_U_ECXDSSD_U_ECSRNPI_U_ECATNPI_U_ECSANPI_U_ECPTNPI_U 203 S ECODE1=ECODE1_ECCLAS_U_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXCPT_U_ECXDOM_U 204 S ECODE1=ECODE1_ECXCAT_U_ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPOS_U_ECXPHI_U 205 S ECODE1=ECODE1_ECXOBS_U_ECXENC_U_ECXAOL_U_ECXPDIV_U_ECXHNCI_U 206 S ECODE1=ECODE1_ECXETH_U_ECXRC1_U_ECXQ_U 207 I ECXLOGIC>2004 S ECODE1=ECODE1_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXORCT_U_ECXPTHA_U_ECXNPRFI 208 I ECXLOGIC>2005 S ECODE1=ECODE1_U_ECXPA_U_ECSRPC_U,ECODE2=ECATPC_U_ECSAPC_U_ECXPAPC 209 I ECXLOGIC>2006 S ECODE2=ECODE2_U_ECXERI_U_ECXAO_U_ECXHNC 210 S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,^ECX(ECFILE,EC7,2)=ECODE2,ECRN=ECRN+1 211 S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA 212 I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1 213 ; 214 TIME ; given date/time get increment 215 ;A1=later, A2=earlier, TIME=difference 216 N CON,TIMEDIF 217 S CON=$P($G(^SRF(ECD0,"CON")),U) 218 ; 219 ;-Get time diff (in secs) & set to .5 if < 7.5 minutes (rounds to 1) 220 S TIMEDIF=$$FMDIFF^XLFDT(A1,A2,2)/900 221 S TIMEDIF=$S(TIMEDIF>0&(TIMEDIF<.5):.5,1:TIMEDIF) 222 I 'CON D 223 .S TIME=$J($TR($J(TIMEDIF,4,0)," "),2,1) 224 .S:TIME>"99.0" TIME="99.0" 225 I CON D 226 .S TIME=$J(($TR($J(TIMEDIF,4,0)," ")/2),2,1) 227 .S:TIME>"99.5" TIME="99.5" 228 S:TIME<0 TIME="###" 229 Q 230 ; 231 SETUP ;Set required input for ECXTRAC 232 S ECHEAD="SUR" 233 D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER) 234 Q 235 ; 236 QUE ; entry point for the background requeuing handled by ECXTAUTO 237 D SETUP,QUE^ECXTAUTO,^ECXKILL Q
Note:
See TracChangeset
for help on using the changeset viewer.
