Changeset 623 for WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXSCXN.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXSCXN.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXSCXN.m
r613 r623 1 ECXSCXN ;ALB/JAP Clinic Extract ; 6/5/07 11:55am 2 ;;3.0;DSS EXTRACTS;**24,27,29,30,31,32,33,39,46,49,52,71,84,92,107,105**;Dec 22, 1997;Build 70 3 ; 4 BEG ;entry point from option 5 D SETUP Q:ECFILE="" D ^ECXTRAC,^ECXKILL 6 Q 7 ; 8 START ;entry point from taskmgr 9 N DIC,EXNUM,I,LOCARR,OUT,P1,P2,P3,PROCESS,SOURCE,STOP,STAT,TOSEND 10 N TIU,X,Y,ECXNPRFI 11 F I=1:1:8 S @("ECXCPT"_I)="" 12 F I=1:1:4 S @("ECXICD9"_I)="" 13 S (OUT,QFLG,ECRN)=0,(ECXICD9P,ECXOBI)="" 14 K ^TMP($J,"ECXS"),^TMP($J,"ECXCL") 15 ;get ien for tiu in file #839.7 16 S DIC="^PX(839.7,",DIC(0)="X",X="TEXT INTEGRATION UTILITIES" 17 D ^DIC S TIU=+Y,ECED=ECED+.3,ECXCLIN=0 K DIC,Y 18 ;get clinic default appt length, type, division 19 F S ECXCLIN=$O(^SC(ECXCLIN)) Q:'ECXCLIN D 20 .K LOCARR S DIC=44,DA=ECXCLIN,DR="2;3.5;1912",DIQ(0)="I",DIQ="LOCARR" 21 .D EN^DIQ1 22 .Q:$G(LOCARR(44,ECXCLIN,2,"I"))'="C" 23 .S ALEN=+$G(LOCARR(44,ECXCLIN,1912,"I")) 24 .S ^TMP($J,"ECXCL",ECXCLIN)=ALEN,ALEN=$$RJ^XLFSTR(ALEN,3,0) 25 .S ^TMP($J,"ECXCL",ECXCLIN)=^TMP($J,"ECXCL",ECXCLIN)_"^"_ALEN_"^"_$G(LOCARR(44,ECXCLIN,2,"I"))_"^"_+$G(LOCARR(44,ECXCLIN,3.5,"I")) 26 .D FEEDER^ECXSCX1(ECXCLIN,ECSD1,.P1,.P2,.P3,.TOSEND,.ECXDIV) 27 .K P1,P2,P3,TOSEND,ECXDIV 28 ;get from file #44 any no-shows & get encounters from #409.68 29 D NOSHOW^ECXSCXN1(ECSD1,ECED),ENCNTR(ECSD1,ECED) 30 ;send missing clinic msg 31 D:$D(^TMP($J,"ECXS")) EN^ECXSCX1 32 K ^TMP($J,"ECXS"),^TMP($J,"ECXCL") 33 Q 34 ; 35 ENCNTR(ECSD1,ECED) ;search file #409.68 for encounter data 36 N CHKOUT,ECD,JJ,K,OUT,PNODE,PP,STAT,STOP,MDIV 37 S ECD=ECSD1 38 F S ECD=$O(^SCE("B",ECD)) Q:('ECD!(ECD>ECED))!(QFLG) S ECXIEN=0 D 39 .F S ECXIEN=$O(^SCE("B",ECD,ECXIEN)) Q:'ECXIEN D Q:QFLG 40 ..Q:'$D(^SCE(ECXIEN,0)) 41 ..D INTPAT^ECXSCX2 K LOCARR S DIC=409.68,DA=ECXIEN 42 ..S DR=".01;.02;.03;.04;.05;.06;.07;.08;.11;.12;.13",DIQ(0)="I",DIQ="LOCARR" 43 ..D EN^DIQ1 44 ..S ECXTI=$P($$FMTE^XLFDT(+$G(LOCARR(409.68,ECXIEN,.01,"I")),1),"@",2) 45 ..S ECXTI=$E(($TR(ECXTI,":","")_"000000"),1,6) 46 ..S:ECXTI="000000" ECXTI="000300" S MDIV=+$G(LOCARR(409.68,ECXIEN,.11,"I")) 47 ..S STOP=+$G(LOCARR(409.68,ECXIEN,.03,"I")) 48 ..S CHKOUT=+$G(LOCARR(409.68,ECXIEN,.07,"I")) 49 ..S PROCESS=+$G(LOCARR(409.68,ECXIEN,.08,"I")) 50 ..S STAT=$G(LOCARR(409.68,ECXIEN,.12,"I")) 51 ..S ECXDFN=+$G(LOCARR(409.68,ECXIEN,.02,"I")) 52 ..Q:(ECXDFN=0)!('CHKOUT) 53 ..S:STAT="" STAT="ZZ" S STAT=";"_STAT_";" 54 ..Q:";3;4;5;6;7;9;10;13;"[STAT 55 ..Q:('STOP)!(PROCESS=4)!(+$G(LOCARR(409.68,ECXIEN,.06,"I"))) 56 ..S ECXDATE=+$G(LOCARR(409.68,ECXIEN,.01,"I")) 57 ..S ECXCLIN=+$G(LOCARR(409.68,ECXIEN,.04,"I")) 58 ..Q:$P($G(^TMP($J,"ECXCL",ECXCLIN)),U,3)'="C" 59 ..S ECXVISIT=+$G(LOCARR(409.68,ECXIEN,.05,"I")) 60 ..S ECXENEL=+$G(LOCARR(409.68,ECXIEN,.13,"I")) 61 ..Q:'ECXVISIT 62 ..S ECXERR=0 63 ..D PAT1^ECXSCX2(ECXDFN,ECXDATE,.ECXERR) Q:ECXERR 64 ..D FEEDER^ECXSCX1(ECXCLIN,ECSD1,.P1,.P2,.P3,.TOSEND,.ECXDIV) 65 ..Q:TOSEND=6 66 ..K LOCARR S DIC=40.7,DA=STOP,DR="1",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1 67 ..S ECXSTOP=$$RJ^XLFSTR($G(LOCARR(40.7,STOP,1,"I")),3,0) 68 ..;get date specific patient data 69 ..D PAT2^ECXSCX2(ECXDFN,ECXDATE) 70 ..;get national patient record flag if exist 71 ..D NPRF^ECXUTL5 72 ..;get visit specific data 73 ..S ECXERR=0 D VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR) Q:ECXERR 74 ..F I=1:1:8 S @("ECXCPT"_I)=$G(ECXVIST("CPT"_I)) 75 ..S ECXICD9P=$G(ECXVIST("ICD9P")) 76 ..F I=1:1:4 S @("ECXICD9"_I)=$G(ECXVIST("ICD9"_I)) 77 ..S SOURCE=ECXVIST("SOURCE"),ECXAO=ECXVIST("AO"),ECXIR=ECXVIST("IR") 78 ..S ECXMIL=ECXVIST("MST"),ECXPROV=ECXVIST("PROV") 79 ..S ECPRNPI=$$NPI^XUSNPI("Individual_ID",ECXPROV,ECXDATE) 80 ..S:+ECPRNPI'>0 ECPRNPI="" S ECPRNPI=$P(ECPRNPI,U) 81 ..S ECXPROVP=ECXVIST("PROV CLASS"),ECXPROVN=ECXVIST("PROV NPI") 82 ..S ECXECE=ECXVIST("PGE"),ECXHNC=ECXVIST("HNC") 83 ..K LOCARR S DIC=8,DA=ECXENEL,DR="8",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1 84 ..S ECXENEL=+$G(LOCARR(8,ECXENEL,8,"I")) 85 ..S:ECXENEL ECXENEL=$$ELIG^ECXUTL3(ECXENEL,ECXSVC) 86 ..S ECXCBOC=$S(MDIV'="":$$CBOC^ECXSCX2(.MDIV),1:"") ;is cboc facility? 87 ..;setup feeder key and file in extract records 88 ..S (ECXKEY,ECXDSSD)="" 89 ..;xray (105) or lab (108) 90 ..I (ECXSTOP=105)!(ECXSTOP=108) D Q 91 ...S ECXKEY=ECXSTOP_"00003000000",ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) 92 ...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE ;- Don't file rec if no encounter num 93 ..;appointments 94 ..I PROCESS=1 D Q ;get appt length 95 ...S (ALEN,JJ,OUT)=0 96 ...F S JJ=$O(^SC(ECXCLIN,"S",ECXDATE,JJ)) Q:('JJ)!(OUT) S K=0 D 97 ....F S K=$O(^SC(ECXCLIN,"S",ECXDATE,JJ,K)) Q:('K)!(OUT) D 98 .....S ECXOBI=$G(^SC(ECXCLIN,"S",ECXDATE,JJ,K,"OB")),PP=$P($G(^SC(ECXCLIN,"S",ECXDATE,JJ,K,0)),U) 99 .....S:PP=ECXDFN OUT=1,ALEN=$P(^(0),U,2),ALEN=$$RJ^XLFSTR(ALEN,3,0) 100 .....S:+ALEN=0 ALEN=$P($G(^TMP($J,"ECXCL",ECXCLIN)),U,2) 101 ....S ECXSTOP=P1 102 ....S PNODE=$G(^DPT(ECXDFN,"S",ECXDATE,0)),ECXPVST=$P(PNODE,U,7),ECXATYP=$P(PNODE,U,16) ;Get purpose of visit & appt type 103 ....I TOSEND'=3 D 104 .....S ECXKEY=P1_P2_ALEN_P3_"0",ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) 105 .....S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE 106 ....I TOSEND=3 D 107 .....S ECXKEY=P1_"000"_ALEN_P3_"0",ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) 108 .....S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE 109 ....I TOSEND=3 D 110 .....S ECXKEY=P2_"000"_ALEN_P3_"0",ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) 111 .....S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE 112 ..I PROCESS=2 D Q 113 ...S ALEN=0 114 ...I SOURCE=TIU S ALEN=$P($G(^TMP($J,"ECXCL",ECXCLIN)),U,2) 115 ...S:+ALEN=0 ALEN="030" S ECXKEY=P1_P2_ALEN_P3_"0",ECXSTOP=P1 116 ...S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) 117 ...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE 118 ..;dispositions 119 ..I PROCESS=3 D Q 120 ...S ECXKEY=ECXSTOP_"47906000000",ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) 121 ...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE 122 Q 123 ; 124 FILE ;record setup for file #727.827 125 N STR 126 S ECXPDIV=$$GETDIV^ECXDEPT(ECXDIV) ; Get production division 127 S EC7=$O(^ECX(727.827,999999999),-1),EC7=EC7+1 128 S STR(0)=EC7_U_EC23_U_ECXDIV_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U 129 S STR(0)=STR(0)_$$ECXDATE^ECXUTL(ECXDATE,ECXYM)_U_ECXKEY_U_ECXOBI_U 130 ;convert specialty to PTF Code for transmission 131 N ECXDATA 132 S ECXDATA=$$TSDATA^DGACT(42.4,+ECXTS,.ECXDATA) 133 S ECXTS=$G(ECXDATA(7)) 134 ;done 135 S STR(0)=STR(0)_ECXCLIN_U_ECXTS_U_ECXTI_U_ECPTTM_U_ECPTPR_U_ECCLAS_U 136 S STR(0)=STR(0)_ECXPROV_U_ECXPROVP_U_ECXCPT1_U_ECXCPT2_U_ECXCPT3_U 137 S STR(0)=STR(0)_ECXCPT4_U_ECXCPT5_U 138 S STR(1)=ECXCPT6_U_ECXCPT7_U_ECXCPT8_U_ECXICD9P_U_ECXICD91_U_ECXICD92_U 139 S STR(1)=STR(1)_ECXICD93_U_ECXICD94_U_ECXDOB_U_ECXELIG_U_ECXVET_U 140 S STR(1)=STR(1)_ECXRACE_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXIR_U_ECXAST_U 141 S STR(1)=STR(1)_ECXAO_U_ECXMPI_U_ECXDSSD_U_ECXSEX_U_ECXZIP_U 142 S STR(1)=STR(1)_$G(ECXPCPNP)_U_U_ECXENEL_U_ECXMST_U 143 S STR(1)=STR(1)_ECXMIL_U_U_U_ECXENRL_U_ECXSTATE_U 144 S STR(1)=STR(1)_ECXCNTY_U_ECASPR_U_ECCLAS2_U_U_ECXDOM_U_ECXCAT_U 145 S STR(2)=ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPHI_U_ECXPOS_U_ECXOBS_U_ECXENC_U 146 S STR(2)=STR(2)_ECXAOL_U_ECXPDIV_U_ECXATYP_U_ECXPVST_U_ECXMTST_U 147 S STR(2)=STR(2)_ECXHNCI_U_ECXETH_U_ECXRC1 148 I ECXLOGIC>2003 S STR(2)=STR(2)_U_ECXCBOC 149 I ECXLOGIC>2004 S STR(2)=STR(2)_U_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI 150 I ECXLOGIC>2005 S STR(2)=STR(2)_U_ECXEST_U_ECXECE 151 I ECXLOGIC>2006 S STR(2)=STR(2)_U_ECXERI_U_ECXHNC 152 I ECXLOGIC>2007 S STR(2)=STR(2)_U_ECXOEF_U_ECXOEFDT_U_ECASNPI_U_ECPTNPI_U_$G(ECPRNPI) 153 D FILE2^ECXSCX2(727.827,EC7,.STR) 154 S ECRN=ECRN+1,$P(^ECX(727.827,0),U,3)=EC7 155 Q 156 ; 157 SETUP ;set required input for ECXTRAC 158 S ECHEAD="CLI" 159 D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER) 160 Q 1 ECXSCXN ;ALB/JAP Clinic Extract ; 4/19/2007 2 ;;3.0;DSS EXTRACTS;**24,27,29,30,31,32,33,39,46,49,52,71,84,92,107**;Dec 22, 1997;Build 9 3 ; 4 BEG ;entry point from option 5 D SETUP Q:ECFILE="" D ^ECXTRAC,^ECXKILL 6 Q 7 ; 8 START ;entry point from taskmgr 9 N DIC,EXNUM,I,LOCARR,OUT,P1,P2,P3,PROCESS,SOURCE,STOP,STAT,TOSEND 10 N TIU,X,Y,ECXNPRFI 11 F I=1:1:8 S @("ECXCPT"_I)="" 12 F I=1:1:4 S @("ECXICD9"_I)="" 13 S (OUT,QFLG,ECRN)=0,(ECXICD9P,ECXOBI)="" 14 K ^TMP($J,"ECXS"),^TMP($J,"ECXCL") 15 ;get ien for tiu in file #839.7 16 S DIC="^PX(839.7,",DIC(0)="X",X="TEXT INTEGRATION UTILITIES" 17 D ^DIC S TIU=+Y,ECED=ECED+.3,ECXCLIN=0 K DIC,Y 18 ;get clinic default appt length, type, division 19 F S ECXCLIN=$O(^SC(ECXCLIN)) Q:'ECXCLIN D 20 .K LOCARR S DIC=44,DA=ECXCLIN,DR="2;3.5;1912",DIQ(0)="I",DIQ="LOCARR" 21 .D EN^DIQ1 22 .Q:$G(LOCARR(44,ECXCLIN,2,"I"))'="C" 23 .S ALEN=+$G(LOCARR(44,ECXCLIN,1912,"I")) 24 .S ^TMP($J,"ECXCL",ECXCLIN)=ALEN,ALEN=$$RJ^XLFSTR(ALEN,3,0) 25 .S ^TMP($J,"ECXCL",ECXCLIN)=^TMP($J,"ECXCL",ECXCLIN)_"^"_ALEN_"^"_$G(LOCARR(44,ECXCLIN,2,"I"))_"^"_+$G(LOCARR(44,ECXCLIN,3.5,"I")) 26 .D FEEDER^ECXSCX1(ECXCLIN,ECSD1,.P1,.P2,.P3,.TOSEND,.ECXDIV) 27 .K P1,P2,P3,TOSEND,ECXDIV 28 ;get from file #44 any no-shows & get encounters from #409.68 29 D NOSHOW^ECXSCXN1(ECSD1,ECED),ENCNTR(ECSD1,ECED) 30 ;send missing clinic msg 31 D:$D(^TMP($J,"ECXS")) EN^ECXSCX1 32 K ^TMP($J,"ECXS"),^TMP($J,"ECXCL") 33 Q 34 ; 35 ENCNTR(ECSD1,ECED) ;search file #409.68 for encounter data 36 N CHKOUT,ECD,JJ,K,OUT,PNODE,PP,STAT,STOP,MDIV 37 S ECD=ECSD1 38 F S ECD=$O(^SCE("B",ECD)) Q:('ECD!(ECD>ECED))!(QFLG) S ECXIEN=0 D 39 .F S ECXIEN=$O(^SCE("B",ECD,ECXIEN)) Q:'ECXIEN D Q:QFLG 40 ..Q:'$D(^SCE(ECXIEN,0)) 41 ..D INTPAT^ECXSCX2 K LOCARR S DIC=409.68,DA=ECXIEN 42 ..S DR=".01;.02;.03;.04;.05;.06;.07;.08;.11;.12;.13",DIQ(0)="I",DIQ="LOCARR" 43 ..D EN^DIQ1 44 ..S ECXTI=$P($$FMTE^XLFDT(+$G(LOCARR(409.68,ECXIEN,.01,"I")),1),"@",2) 45 ..S ECXTI=$E(($TR(ECXTI,":","")_"000000"),1,6) 46 ..S:ECXTI="000000" ECXTI="000300" S MDIV=+$G(LOCARR(409.68,ECXIEN,.11,"I")) 47 ..S STOP=+$G(LOCARR(409.68,ECXIEN,.03,"I")) 48 ..S CHKOUT=+$G(LOCARR(409.68,ECXIEN,.07,"I")) 49 ..S PROCESS=+$G(LOCARR(409.68,ECXIEN,.08,"I")) 50 ..S STAT=$G(LOCARR(409.68,ECXIEN,.12,"I")) 51 ..S ECXDFN=+$G(LOCARR(409.68,ECXIEN,.02,"I")) 52 ..Q:(ECXDFN=0)!('CHKOUT) 53 ..S:STAT="" STAT="ZZ" S STAT=";"_STAT_";" 54 ..Q:";3;4;5;6;7;9;10;13;"[STAT 55 ..Q:('STOP)!(PROCESS=4)!(+$G(LOCARR(409.68,ECXIEN,.06,"I"))) 56 ..S ECXDATE=+$G(LOCARR(409.68,ECXIEN,.01,"I")) 57 ..S ECXCLIN=+$G(LOCARR(409.68,ECXIEN,.04,"I")) 58 ..Q:$P($G(^TMP($J,"ECXCL",ECXCLIN)),U,3)'="C" 59 ..S ECXVISIT=+$G(LOCARR(409.68,ECXIEN,.05,"I")) 60 ..S ECXENEL=+$G(LOCARR(409.68,ECXIEN,.13,"I")) 61 ..Q:'ECXVISIT 62 ..S ECXERR=0 63 ..D PAT1^ECXSCX2(ECXDFN,ECXDATE,.ECXERR) Q:ECXERR 64 ..D FEEDER^ECXSCX1(ECXCLIN,ECSD1,.P1,.P2,.P3,.TOSEND,.ECXDIV) 65 ..Q:TOSEND=6 66 ..K LOCARR S DIC=40.7,DA=STOP,DR="1",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1 67 ..S ECXSTOP=$$RJ^XLFSTR($G(LOCARR(40.7,STOP,1,"I")),3,0) 68 ..;get date specific patient data 69 ..D PAT2^ECXSCX2(ECXDFN,ECXDATE) 70 ..;get national patient record flag if exist 71 ..D NPRF^ECXUTL5 72 ..;get visit specific data 73 ..S ECXERR=0 D VISIT^ECXSCX1(ECXDFN,ECXVISIT,.ECXVIST,.ECXERR) Q:ECXERR 74 ..F I=1:1:8 S @("ECXCPT"_I)=$G(ECXVIST("CPT"_I)) 75 ..S ECXICD9P=$G(ECXVIST("ICD9P")) 76 ..F I=1:1:4 S @("ECXICD9"_I)=$G(ECXVIST("ICD9"_I)) 77 ..S SOURCE=ECXVIST("SOURCE"),ECXAO=ECXVIST("AO"),ECXIR=ECXVIST("IR") 78 ..S ECXMIL=ECXVIST("MST"),ECXPROV=ECXVIST("PROV") 79 ..S ECXPROVP=ECXVIST("PROV CLASS"),ECXPROVN=ECXVIST("PROV NPI") 80 ..S ECXECE=ECXVIST("PGE"),ECXHNC=ECXVIST("HNC") 81 ..K LOCARR S DIC=8,DA=ECXENEL,DR="8",DIQ(0)="I",DIQ="LOCARR" D EN^DIQ1 82 ..S ECXENEL=+$G(LOCARR(8,ECXENEL,8,"I")) 83 ..S:ECXENEL ECXENEL=$$ELIG^ECXUTL3(ECXENEL,ECXSVC) 84 ..S ECXCBOC=$S(MDIV'="":$$CBOC^ECXSCX2(.MDIV),1:"") ;is cboc facility? 85 ..;setup feeder key and file in extract records 86 ..S (ECXKEY,ECXDSSD)="" 87 ..;xray (105) or lab (108) 88 ..I (ECXSTOP=105)!(ECXSTOP=108) D Q 89 ...S ECXKEY=ECXSTOP_"00003000000",ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) 90 ...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE ;- Don't file rec if no encounter num 91 ..;appointments 92 ..I PROCESS=1 D Q ;get appt length 93 ...S (ALEN,JJ,OUT)=0 94 ...F S JJ=$O(^SC(ECXCLIN,"S",ECXDATE,JJ)) Q:('JJ)!(OUT) S K=0 D 95 ....F S K=$O(^SC(ECXCLIN,"S",ECXDATE,JJ,K)) Q:('K)!(OUT) D 96 .....S ECXOBI=$G(^SC(ECXCLIN,"S",ECXDATE,JJ,K,"OB")),PP=$P($G(^SC(ECXCLIN,"S",ECXDATE,JJ,K,0)),U) 97 .....S:PP=ECXDFN OUT=1,ALEN=$P(^(0),U,2),ALEN=$$RJ^XLFSTR(ALEN,3,0) 98 .....S:+ALEN=0 ALEN=$P($G(^TMP($J,"ECXCL",ECXCLIN)),U,2) 99 ....S ECXSTOP=P1 100 ....S PNODE=$G(^DPT(ECXDFN,"S",ECXDATE,0)),ECXPVST=$P(PNODE,U,7),ECXATYP=$P(PNODE,U,16) ;Get purpose of visit & appt type 101 ....I TOSEND'=3 D 102 .....S ECXKEY=P1_P2_ALEN_P3_"0",ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) 103 .....S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE 104 ....I TOSEND=3 D 105 .....S ECXKEY=P1_"000"_ALEN_P3_"0",ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) 106 .....S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE 107 ....I TOSEND=3 D 108 .....S ECXKEY=P2_"000"_ALEN_P3_"0",ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) 109 .....S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE 110 ..I PROCESS=2 D Q 111 ...S ALEN=0 112 ...I SOURCE=TIU S ALEN=$P($G(^TMP($J,"ECXCL",ECXCLIN)),U,2) 113 ...S:+ALEN=0 ALEN="030" S ECXKEY=P1_P2_ALEN_P3_"0",ECXSTOP=P1 114 ...S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) 115 ...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE 116 ..;dispositions 117 ..I PROCESS=3 D Q 118 ...S ECXKEY=ECXSTOP_"47906000000",ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS,ECXKEY) 119 ...S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,ECXDATE,ECXTS,ECXOBS,ECHEAD,ECXKEY,) D:ECXENC'="" FILE 120 Q 121 ; 122 FILE ;record setup for file #727.827 123 N STR 124 S ECXPDIV=$$GETDIV^ECXDEPT(ECXDIV) ; Get production division 125 S EC7=$O(^ECX(727.827,999999999),-1),EC7=EC7+1 126 S STR(0)=EC7_U_EC23_U_ECXDIV_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U 127 S STR(0)=STR(0)_$$ECXDATE^ECXUTL(ECXDATE,ECXYM)_U_ECXKEY_U_ECXOBI_U 128 ;convert specialty to PTF Code for transmission 129 N ECXDATA 130 S ECXDATA=$$TSDATA^DGACT(42.4,+ECXTS,.ECXDATA) 131 S ECXTS=$G(ECXDATA(7)) 132 ;done 133 S STR(0)=STR(0)_ECXCLIN_U_ECXTS_U_ECXTI_U_ECPTTM_U_ECPTPR_U_ECCLAS_U 134 S STR(0)=STR(0)_ECXPROV_U_ECXPROVP_U_ECXCPT1_U_ECXCPT2_U_ECXCPT3_U 135 S STR(0)=STR(0)_ECXCPT4_U_ECXCPT5_U 136 S STR(1)=ECXCPT6_U_ECXCPT7_U_ECXCPT8_U_ECXICD9P_U_ECXICD91_U_ECXICD92_U 137 S STR(1)=STR(1)_ECXICD93_U_ECXICD94_U_ECXDOB_U_ECXELIG_U_ECXVET_U 138 S STR(1)=STR(1)_ECXRACE_U_ECXPST_U_ECXPLOC_U_ECXRST_U_ECXIR_U_ECXAST_U 139 S STR(1)=STR(1)_ECXAO_U_ECXMPI_U_ECXDSSD_U_ECXSEX_U_ECXZIP_U 140 S STR(1)=STR(1)_$G(ECXPCPNP)_U_$G(ECXNPIPR)_U_ECXENEL_U_ECXMST_U 141 S STR(1)=STR(1)_ECXMIL_U_U_U_ECXENRL_U_ECXSTATE_U 142 S STR(1)=STR(1)_ECXCNTY_U_ECASPR_U_ECCLAS2_U_ECASNPI_U_ECXDOM_U_ECXCAT_U 143 S STR(2)=ECXSTAT_U_$S(ECXLOGIC<2005:ECXPRIOR,1:"")_U_ECXPHI_U_ECXPOS_U_ECXOBS_U_ECXENC_U 144 S STR(2)=STR(2)_ECXAOL_U_ECXPDIV_U_ECXATYP_U_ECXPVST_U_ECXMTST_U 145 S STR(2)=STR(2)_ECXHNCI_U_ECXETH_U_ECXRC1 146 I ECXLOGIC>2003 S STR(2)=STR(2)_U_ECXCBOC 147 I ECXLOGIC>2004 S STR(2)=STR(2)_U_U_ECXPRIOR_ECXSBGRP_U_ECXUESTA_U_ECXPTYPE_U_ECXCVE_U_ECXCVEDT_U_ECXCVENC_U_ECXNPRFI 148 I ECXLOGIC>2005 S STR(2)=STR(2)_U_ECXEST_U_ECXECE 149 I ECXLOGIC>2006 S STR(2)=STR(2)_U_ECXERI_U_ECXHNC 150 D FILE2^ECXSCX2(727.827,EC7,.STR) 151 S ECRN=ECRN+1,$P(^ECX(727.827,0),U,3)=EC7 152 Q 153 ; 154 SETUP ;set required input for ECXTRAC 155 S ECHEAD="CLI" 156 D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER) 157 Q
Note:
See TracChangeset
for help on using the changeset viewer.
