| [613] | 1 | ECXDENT ;ALB/JAP,BIR/DMA,PTD-Dental Extract for DSS ; [ 11/22/96 5:23 PM ]
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**11,8,13,24,33,39,46**;Dec 22, 1997
|
|---|
| 3 | BEG ;entry point from option
|
|---|
| 4 | D SETUP I ECFILE="" Q
|
|---|
| 5 | D ^ECXTRAC,^ECXKILL
|
|---|
| 6 | Q
|
|---|
| 7 | ;
|
|---|
| 8 | START ;start package specific extract
|
|---|
| 9 | N DATA,X,Y
|
|---|
| 10 | K ECXDD D FIELD^DID(220.5,.01,,"SPECIFIER","ECXDD")
|
|---|
| 11 | S ECPRO=$E(+$P(ECXDD("SPECIFIER"),"P",2)) K ECXDD
|
|---|
| 12 | S ECED=ECED+.3,ECD=ECSD1,QFLG=0
|
|---|
| 13 | F S ECD=$O(^DENT(221,"B",ECD)),ECXJ=0 Q:('ECD)!(ECD>ECED)!(QFLG) D
|
|---|
| 14 | .F S ECXJ=$O(^DENT(221,"B",ECD,ECXJ)) Q:'ECXJ D Q:QFLG
|
|---|
| 15 | ..Q:'$D(^DENT(221,ECXJ,0))
|
|---|
| 16 | ..S DATA=^DENT(221,ECXJ,0),$P(DATA,U,50)="" D STUFF
|
|---|
| 17 | Q
|
|---|
| 18 | STUFF ;get data
|
|---|
| 19 | K ECXPAT
|
|---|
| 20 | S ECXDFN=+$P(DATA,U,4),OK=$$PAT^ECXUTL3(ECXDFN,$P(ECD,"."),"1;",.ECXPAT)
|
|---|
| 21 | Q:'OK
|
|---|
| 22 | S ECXPNM=ECXPAT("NAME"),ECXSSN=ECXPAT("SSN"),ECXMPI=ECXPAT("MPI")
|
|---|
| 23 | S X=$$INP^ECXUTL2(ECXDFN,ECD),ECXA=$P(X,U),ECXMN=$P(X,U,2)
|
|---|
| 24 | S ECXTS=$P(X,U,3),ECXDOM=$P(X,U,10),ECXADMDT=$P(X,U,4)
|
|---|
| 25 | S ECDEN=$P(DATA,U,3),ECDEN=$P($G(^DENT(220.5,ECDEN,0)),U)
|
|---|
| 26 | S:ECDEN]"" ECDEN=ECPRO_ECDEN S ECDENNPI=""
|
|---|
| 27 | S X=$$PRIMARY^ECXUTL2(ECXDFN,$P(ECD,"."),ECPRO)
|
|---|
| 28 | S ECPTTM=$P(X,U,1),ECPTPR=$P(X,U,2),ECCLAS=$P(X,U,3),ECPTNPI=$P(X,U,4)
|
|---|
| 29 | S ECASPR=$P(X,U,5),ECCLAS2=$P(X,U,6),ECASNPI=$P(X,U,7)
|
|---|
| 30 | ;use of dss department delayed S ECXDSSD=$$DEN^ECXDEPT($P(DATA,U,40))
|
|---|
| 31 | S ECXDSSD=""
|
|---|
| 32 | ;
|
|---|
| 33 | ;- Observation patient indicator (YES/NO)
|
|---|
| 34 | S ECXOBS=$$OBSPAT^ECXUTL4(ECXA,ECXTS)
|
|---|
| 35 | ;
|
|---|
| 36 | ;- If no encounter number don't file record
|
|---|
| 37 | S ECXENC=$$ENCNUM^ECXUTL4(ECXA,ECXSSN,ECXADMDT,$P(DATA,U),ECXTS,ECXOBS,ECHEAD,,)
|
|---|
| 38 | D:ECXENC'="" FILE
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | FILE ;file record
|
|---|
| 42 | ;node0
|
|---|
| 43 | ;inst^dfn^ssn^name^in/out ECXA^day^provider^screen/complete^admin proc^
|
|---|
| 44 | ;x-rays ex^x-rays int^prophy natural^prophy denture^op room^
|
|---|
| 45 | ;neoplasm malig^
|
|---|
| 46 | ;neoplasm removed^biopsy/smear^fracture^pat category^other sig surg^
|
|---|
| 47 | ;surface restored^root canal^periodontal quads (surg)^
|
|---|
| 48 | ;perio quads (root plane)^
|
|---|
| 49 | ;patient ed^spot check exam^indiv crowns^posts & cores^
|
|---|
| 50 | ;fixed partials (abut)^fixed partials (pont)^removable partials^
|
|---|
| 51 | ;complete dentures^prosthetic repair^
|
|---|
| 52 | ;splints & spec procs^extractions^surg extractions^other sig treatment^
|
|---|
| 53 | ;div^completion/termination^interdisc consult^evaluation^
|
|---|
| 54 | ;pre-auth 2nd opinion^
|
|---|
| 55 | ;spot check discrepancy^mov #^treat spec^primary care team^
|
|---|
| 56 | ;primary care provider^time
|
|---|
| 57 | ;node1
|
|---|
| 58 | ;mpi^dss dept^provider npi^pc provider npi^pc prov person class^
|
|---|
| 59 | ;assoc pc prov^assoc pc prov person class^assoc pc prov npi^
|
|---|
| 60 | ;dom ECXDOM^observ pat ind ECXOBS^encounter num ECXENC^
|
|---|
| 61 | ;production division
|
|---|
| 62 | ;
|
|---|
| 63 | N DA,DIK
|
|---|
| 64 | S EC7=$O(^ECX(ECFILE,999999999),-1),EC7=EC7+1
|
|---|
| 65 | S ECODE=EC7_U_EC23_U
|
|---|
| 66 | S ECODE=ECODE_$P(DATA,U,40)_U_ECXDFN_U_ECXSSN_U_ECXPNM_U_ECXA_U
|
|---|
| 67 | S ECODE=ECODE_$$ECXDATE^ECXUTL($P(DATA,U),ECXYM)_U_ECDEN_U
|
|---|
| 68 | S ECODE=ECODE_$P(DATA,U,7,9)_U_$P(DATA,U,11,20)_U_$P(DATA,U,22,38)_U
|
|---|
| 69 | S ECODE=ECODE_$P(DATA,U,40,45)_U_ECXMN_U_ECXTS_U
|
|---|
| 70 | S ECODE=ECODE_ECPTTM_U_ECPTPR_U_$$ECXTIME^ECXUTL($P(DATA,U))_U
|
|---|
| 71 | S ECODE1=ECXMPI_U_ECXDSSD_U_ECDENNPI_U_ECPTNPI_U_ECCLAS_U_ECASPR_U
|
|---|
| 72 | S ECODE1=ECODE1_ECCLAS2_U_ECASNPI_U_ECXDOM_U_ECXOBS_U_ECXENC_U_$P(DATA,U,40) ;p-46 added U_$P(DATA,U,40)
|
|---|
| 73 | S ^ECX(ECFILE,EC7,0)=ECODE,^ECX(ECFILE,EC7,1)=ECODE1,ECRN=ECRN+1
|
|---|
| 74 | S DA=EC7,DIK="^ECX("_ECFILE_"," D IX1^DIK K DIK,DA
|
|---|
| 75 | I $D(ZTQUEUED),$$S^%ZTLOAD S QFLG=1
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | SETUP ;Set required input for ECXTRAC
|
|---|
| 79 | S ECHEAD="DEN"
|
|---|
| 80 | D ECXDEF^ECXUTL2(ECHEAD,.ECPACK,.ECGRP,.ECFILE,.ECRTN,.ECPIECE,.ECVER)
|
|---|
| 81 | Q
|
|---|
| 82 | ;
|
|---|
| 83 | QUE ; entry point for the background requeuing handled by ECXTAUTO
|
|---|
| 84 | D SETUP,QUE^ECXTAUTO,^ECXKILL Q
|
|---|
