Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECXDENT

ECXDENT.m

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