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