- ECXADEN ;ALB/JAP - DEN Extract Audit Report ;Oct 10, 1997
- ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997
- ;
- EN ;entry point for DEN extract audit report
- ;select extract
- N %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,SITES,ECX
- ;ecxaud=0 for 'extract' audit
- S ECXERR=0
- S ECXHEAD="DEN",ECXAUD=0
- W !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
- D AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
- Q:ECXERR
- ;determine if facility is multidivisional
- K ECX D FILE^DID(225,,"ENTRIES","ECX") S SITES=ECX("ENTRIES") K ECX
- I SITES=1 S ECXALL=1
- I SITES>1 D
- .W !!
- .S DIR(0)="Y",DIR("A")="Do you want the "_ECXHEAD_" extract audit report for all divisions"
- .S DIR("B")="NO" D ^DIR K DIR
- .I $G(DIRUT) S ECXERR=1 Q
- .;if y=0 i.e., 'no', then ecxall=0 i.e., 'selected'
- .S ECXALL=Y
- I ECXERR=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .D AUDIT^ECXKILL
- ;select divisions/sites; all divisions if ecxall=1
- W !
- S ECXSTART=ECXARRAY("START"),ECXEND=ECXARRAY("END")
- D DEN^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
- I ECXERR=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .D AUDIT^ECXKILL
- ;determine output device and queue if requested
- S ECXPGM="PROCESS^ECXADEN",ECXDESC="DEN Extract Audit Report"
- S ECXSAVE("ECXHEAD")="",ECXSAVE("ECXALL")="",ECXSAVE("ECXDIV(")="",ECXSAVE("ECXARRAY(")=""
- W !
- D DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
- I ECXSAVE("POP")=1 D Q
- .W !!,?5,"Try again later... exiting.",!
- .D AUDIT^ECXKILL
- I ECXSAVE("ZTSK")=0 D
- .K ECXSAVE,ECXPGM,ECXDESC
- .D PROCESS^ECXADEN
- I IO'=IO(0) D ^%ZISC
- D HOME^%ZIS
- D AUDIT^ECXKILL
- Q
- ;
- PROCESS ;process data in file #727.806
- N X,Y,JJ,DATE,DIV,IEN,DFN,SXAM,CXAM,EXAM,PT,TMP,TOTPTS,QQFLG,CNT
- K ^TMP($J,"ECXAUD"),^TMP($J,"ECXPATS"),^TMP($J,"ECXPROC")
- S (CNT,QQFLG)=0
- S ECXEXT=ECXARRAY("EXTRACT"),ECXDEF=ECXARRAY("DEF")
- S X=ECXARRAY("START") D ^%DT S ECXSTART=Y S X=ECXARRAY("END") D ^%DT S ECXEND=Y
- ;get run date in external format
- D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S ECXRUN=Y
- ;convert ecxdiv array to be subscripted by dental site id #
- S JJ=0 F S JJ=$O(ECXDIV(JJ)) Q:JJ="" S DIV=$P(ECXDIV(JJ),U,3),DIV(DIV)=JJ
- ;get records within date range and dental site(s)
- S IEN="" F S IEN=$O(^ECX(727.806,"AC",ECXEXT,IEN)) Q:IEN="" D Q:QQFLG
- .S PT=^ECX(727.806,IEN,0)
- .S DATE=$P(PT,U,9),DIV=$P(PT,U,41)
- .;convert free text date to fm internal format date
- .S $E(DATE,1,2)=$E(DATE,1,2)-17
- .Q:$L(DATE)<7 Q:(DATE<ECXSTART) Q:(DATE>ECXEND)
- .;if dental division is in selected set, then tally dental data
- .Q:'$D(DIV(DIV))
- .S DFN=$P(PT,U,5),(SXAM,CXAM)=0,EXAM=$P(PT,U,11) S:EXAM="S" SXAM=1 S:EXAM="C" CXAM=1
- .S DATA=SXAM_U_CXAM_U
- .S DATA=DATA_+$P(PT,U,44)_U_+$P(PT,U,13)_U_+$P(PT,U,14)_U_+$P(PT,U,18)_U_+$P(PT,U,24)_U_+$P(PT,U,25)_U_+$P(PT,U,26)_U_+$P(PT,U,27)_U
- .S DATA=DATA_+$P(PT,U,15)_U_+$P(PT,U,16)_U_+$P(PT,U,38)_U_+$P(PT,U,39)_U_+$P(PT,U,19)_U_+$P(PT,U,20)_U_+$P(PT,U,21)_U
- .S DATA=DATA_+$P(PT,U,30)_U_+$P(PT,U,31)_U_+$P(PT,U,32)_U_+$P(PT,U,33)_U_+$P(PT,U,34)_U_+$P(PT,U,35)_U_+$P(PT,U,36)
- .I '$D(^TMP($J,"ECXAUD",DIV,DFN)) S ^TMP($J,"ECXAUD",DIV,DFN)="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
- .S TMP=^TMP($J,"ECXAUD",DIV,DFN)
- .F JJ=1:1:24 S $P(TMP,U,JJ)=$P(TMP,U,JJ)+$P(DATA,U,JJ)
- .S ^TMP($J,"ECXAUD",DIV,DFN)=TMP,CNT=CNT+1
- .I $D(ZTQUEUED),(CNT>499),'(CNT#500),$$S^%ZTLOAD S QQFLG=1,ZTSTOP=1 K ZTREQ Q
- ;after all dental extract records processed, then do totals by patient and procedure
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
- S DIV="" F S DIV=$O(DIV(DIV)) Q:DIV="" S TOTPTS(DIV)=0 F JJ=1:1:24 S ^TMP($J,"ECXPROC",DIV,JJ)=0,^TMP($J,"ECXPATS",DIV,JJ)=0
- S DIV="" F S DIV=$O(^TMP($J,"ECXAUD",DIV)) Q:DIV="" D
- .S DFN="" F S DFN=$O(^TMP($J,"ECXAUD",DIV,DFN)) Q:DFN="" D
- ..S TMP=^TMP($J,"ECXAUD",DIV,DFN),TOTPTS(DIV)=TOTPTS(DIV)+1
- ..F JJ=1:1:24 S ^TMP($J,"ECXPROC",DIV,JJ)=^TMP($J,"ECXPROC",DIV,JJ)+$P(TMP,U,JJ) I +$P(TMP,U,JJ)>0 S ^TMP($J,"ECXPATS",DIV,JJ)=^TMP($J,"ECXPATS",DIV,JJ)+1
- ;print the report
- D PRINT
- D AUDIT^ECXKILL
- Q
- ;
- PRINT ;print the DEN audit report by dental site
- N LN,P,PG,SS,QFLG,GTPROC,GTPAT,TPROC,TPAT,DIEN,TEXT
- U IO
- I $D(ZTQUEUED),$$S^%ZTLOAD S ZTSTOP=1 K ZTREQ Q
- S (QFLG,PG)=0,$P(LN,"-",80)="",DIV=""
- F S DIV=$O(^TMP($J,"ECXPROC",DIV)) Q:DIV="" S DIEN=DIV(DIV) D Q:QFLG
- .S (GTPROC,GTPAT)=0
- .D HEADER Q:QFLG
- .I TOTPTS(DIV)=0 D Q
- ..W !!,?28,"No data for Dental Site "_$P(ECXDIV(DIEN),U,3)_".",!
- .S GTPAT=TOTPTS(DIV)
- .F P=1:1:24 D Q:QFLG
- ..S TEXT=$T(DENT+P),TEXT=$P(TEXT,";;",2),TPROC=^TMP($J,"ECXPROC",DIV,P),TPAT=^TMP($J,"ECXPATS",DIV,P),GTPROC=GTPROC+TPROC
- ..D:($Y+3>IOSL) HEADER Q:QFLG
- ..W !,$E($P(TEXT,U,1),1,25),?28,$E($P(TEXT,U,2),1,25),?56,$$RJ^XLFSTR(TPROC,5," "),?70,$$RJ^XLFSTR(TPAT,5," ")
- .D:($Y+3>IOSL) HEADER Q:QFLG W !!
- .D:($Y+3>IOSL) HEADER Q:QFLG W !,?56,"-----",?70,"-----"
- .D:($Y+3>IOSL) HEADER Q:QFLG W !,"Totals for Dental Site "_$P(ECXDIV(DIEN),U,3)_":",?56,$$RJ^XLFSTR(GTPROC,5," "),?70,$$RJ^XLFSTR(GTPAT,5," ")," **"
- .D:($Y+3>IOSL) HEADER Q:QFLG W !!,"** Total # of unique patients.",!
- I $E(IOST)'="C" D
- .W @IOF S PG=PG+1
- .W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- .W !,"DSS Extract Log #: "_ECXEXT
- .W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- .W !,"Report Run Date/Time: "_ECXRUN,?70,"Page: ",PG
- .W !!,LN,!!
- .S DIC="^ECX(727.1,",DA=ECXARRAY("DEF"),DR="1" D EN^DIQ
- .W @IOF
- I $E(IOST)="C",'QFLG D
- .S SS=22-$Y F JJ=1:1:SS W !
- .S DIR(0)="E" W ! D ^DIR K DIR
- Q
- ;
- N JJ,SS
- I $E(IOST)="C" D
- .S SS=22-$Y F JJ=1:1:SS W !
- .I PG>0 S DIR(0)="E" W ! D ^DIR K DIR S:'Y QFLG=1
- Q:QFLG
- W:$Y!($E(IOST)="C") @IOF S PG=PG+1
- W !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- W !,"DSS Extract Log #: "_ECXEXT
- W !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- W !,"Report Run Date/Time: "_ECXRUN
- I $P(ECXDIV(DIEN),U,2)="" S $P(ECXDIV(DIEN),U,2)="Unknown"
- W !,"Dental Site: "_$P(ECXDIV(DIEN),U,3)_" ("_$P(ECXDIV(DIEN),U,2)_")",?70,"Page: "_PG
- W !!,?56,"# of",?70,"# of"
- W !,"DSS Procedure",?28,"Dental Procedure",?56,"Procedures",?70,"Patients"
- W !,LN,!
- Q
- ;
- DENT ;;procedure names for report
- ;;Screening Exam^ SCREENING EXAMINATION
- ;;Complete Exam^ COMPLETE EXAMINATION
- ;;Evaluation^ EVALUATION
- ;;X-Rays Extraoral^ DIAGNOSTIC FILMS-EXTRAORAL
- ;;X-Rays Intraoral^ DIAGNOSTIC FILMS-INTRAORAL
- ;;Neoplasm Confirmed Malignant^ MALIGNANT NEOPLASM CONFIRMED
- ;;Surfaces Restored^ SURFACE RESTORED
- ;;Root Canal Therapy^ ROOT CANAL FILLED
- ;;Periodontal Quads (Surgical)^ QUADRANT OF PERIODONTAL SURGERY
- ;;Periodontal Quads (Root Plane)^ QUADRANT OF ROOT PLANING AND CURETTAGE
- ;;Prophy Natural Dentition^ PROPHYLAXIS - NATURAL DENTITION
- ;;Prophy Denture^ PATIENT WITH PROTHESES CLEANED
- ;;Extractions^ EXTRACTIONS (WEIGHTED)
- ;;Surgical Extractions^ SURGICAL EXTRACTION
- ;;Neoplasm Removed^ NEOPLASM REMOVED
- ;;Biopsy/Smear^ BIOPSY AND/OR CYTOLOGICAL SMEARS
- ;;Fracture^ MAXILLOFACIAL FRACTURE REDUCTION
- ;;Individual Crowns^ SINGLE CROWN (PER CROWN)
- ;;Post & Cores^ POST AND CORE OR OVERDENTURE COPING
- ;;Fixed Partials (Abut)^ ABUTMENT UNIT FOR FIXED PROSTHESIS
- ;;Fixed Partials (Pont Only)^ PONTIC UNIT FOR FIXED PROSTHESIS
- ;;Removable Partials^ REMOVABLE PARTIAL DENTURE INSERTED
- ;;Complete Dentures^ REMOVABLE COMPLETE DENTURE INSERTED
- ;;Prosthetic Repair^ PROTHESIS REPAIRED
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXADEN 7442 printed Jan 18, 2025@02:53:07 Page 2
- ECXADEN ;ALB/JAP - DEN Extract Audit Report ;Oct 10, 1997
- +1 ;;3.0;DSS EXTRACTS;**8**;Dec 22, 1997
- +2 ;
- EN ;entry point for DEN extract audit report
- +1 ;select extract
- +2 NEW %X,%Y,X,Y,DIC,DA,DR,DIQ,DIR,SITES,ECX
- +3 ;ecxaud=0 for 'extract' audit
- +4 SET ECXERR=0
- +5 SET ECXHEAD="DEN"
- SET ECXAUD=0
- +6 WRITE !!,"Setup for ",ECXHEAD," Extract Audit Report --",!!
- +7 DO AUDIT^ECXUTLA(ECXHEAD,.ECXERR,.ECXARRAY,ECXAUD)
- +8 if ECXERR
- QUIT
- +9 ;determine if facility is multidivisional
- +10 KILL ECX
- DO FILE^DID(225,,"ENTRIES","ECX")
- SET SITES=ECX("ENTRIES")
- KILL ECX
- +11 IF SITES=1
- SET ECXALL=1
- +12 IF SITES>1
- Begin DoDot:1
- +13 WRITE !!
- +14 SET DIR(0)="Y"
- SET DIR("A")="Do you want the "_ECXHEAD_" extract audit report for all divisions"
- +15 SET DIR("B")="NO"
- DO ^DIR
- KILL DIR
- +16 IF $GET(DIRUT)
- SET ECXERR=1
- QUIT
- +17 ;if y=0 i.e., 'no', then ecxall=0 i.e., 'selected'
- +18 SET ECXALL=Y
- End DoDot:1
- +19 IF ECXERR=1
- Begin DoDot:1
- +20 WRITE !!,?5,"Try again later... exiting.",!
- +21 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +22 ;select divisions/sites; all divisions if ecxall=1
- +23 WRITE !
- +24 SET ECXSTART=ECXARRAY("START")
- SET ECXEND=ECXARRAY("END")
- +25 DO DEN^ECXDVSN(.ECXDIV,ECXALL,.ECXERR)
- +26 IF ECXERR=1
- Begin DoDot:1
- +27 WRITE !!,?5,"Try again later... exiting.",!
- +28 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +29 ;determine output device and queue if requested
- +30 SET ECXPGM="PROCESS^ECXADEN"
- SET ECXDESC="DEN Extract Audit Report"
- +31 SET ECXSAVE("ECXHEAD")=""
- SET ECXSAVE("ECXALL")=""
- SET ECXSAVE("ECXDIV(")=""
- SET ECXSAVE("ECXARRAY(")=""
- +32 WRITE !
- +33 DO DEVICE^ECXUTLA(ECXPGM,ECXDESC,.ECXSAVE)
- +34 IF ECXSAVE("POP")=1
- Begin DoDot:1
- +35 WRITE !!,?5,"Try again later... exiting.",!
- +36 DO AUDIT^ECXKILL
- End DoDot:1
- QUIT
- +37 IF ECXSAVE("ZTSK")=0
- Begin DoDot:1
- +38 KILL ECXSAVE,ECXPGM,ECXDESC
- +39 DO PROCESS^ECXADEN
- End DoDot:1
- +40 IF IO'=IO(0)
- DO ^%ZISC
- +41 DO HOME^%ZIS
- +42 DO AUDIT^ECXKILL
- +43 QUIT
- +44 ;
- PROCESS ;process data in file #727.806
- +1 NEW X,Y,JJ,DATE,DIV,IEN,DFN,SXAM,CXAM,EXAM,PT,TMP,TOTPTS,QQFLG,CNT
- +2 KILL ^TMP($JOB,"ECXAUD"),^TMP($JOB,"ECXPATS"),^TMP($JOB,"ECXPROC")
- +3 SET (CNT,QQFLG)=0
- +4 SET ECXEXT=ECXARRAY("EXTRACT")
- SET ECXDEF=ECXARRAY("DEF")
- +5 SET X=ECXARRAY("START")
- DO ^%DT
- SET ECXSTART=Y
- SET X=ECXARRAY("END")
- DO ^%DT
- SET ECXEND=Y
- +6 ;get run date in external format
- +7 DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- DO DD^%DT
- SET ECXRUN=Y
- +8 ;convert ecxdiv array to be subscripted by dental site id #
- +9 SET JJ=0
- FOR
- SET JJ=$ORDER(ECXDIV(JJ))
- if JJ=""
- QUIT
- SET DIV=$PIECE(ECXDIV(JJ),U,3)
- SET DIV(DIV)=JJ
- +10 ;get records within date range and dental site(s)
- +11 SET IEN=""
- FOR
- SET IEN=$ORDER(^ECX(727.806,"AC",ECXEXT,IEN))
- if IEN=""
- QUIT
- Begin DoDot:1
- +12 SET PT=^ECX(727.806,IEN,0)
- +13 SET DATE=$PIECE(PT,U,9)
- SET DIV=$PIECE(PT,U,41)
- +14 ;convert free text date to fm internal format date
- +15 SET $EXTRACT(DATE,1,2)=$EXTRACT(DATE,1,2)-17
- +16 if $LENGTH(DATE)<7
- QUIT
- if (DATE<ECXSTART)
- QUIT
- if (DATE>ECXEND)
- QUIT
- +17 ;if dental division is in selected set, then tally dental data
- +18 if '$DATA(DIV(DIV))
- QUIT
- +19 SET DFN=$PIECE(PT,U,5)
- SET (SXAM,CXAM)=0
- SET EXAM=$PIECE(PT,U,11)
- if EXAM="S"
- SET SXAM=1
- if EXAM="C"
- SET CXAM=1
- +20 SET DATA=SXAM_U_CXAM_U
- +21 SET DATA=DATA_+$PIECE(PT,U,44)_U_+$PIECE(PT,U,13)_U_+$PIECE(PT,U,14)_U_+$PIECE(PT,U,18)_U_+$PIECE(PT,U,24)_U_+$PIECE(PT,U,25)_U_+$PIECE(PT,U,26)_U_+$PIECE(PT,U,27)_U
- +22 SET DATA=DATA_+$PIECE(PT,U,15)_U_+$PIECE(PT,U,16)_U_+$PIECE(PT,U,38)_U_+$PIECE(PT,U,39)_U_+$PIECE(PT,U,19)_U_+$PIECE(PT,U,20)_U_+$PIECE(PT,U,21)_U
- +23 SET DATA=DATA_+$PIECE(PT,U,30)_U_+$PIECE(PT,U,31)_U_+$PIECE(PT,U,32)_U_+$PIECE(PT,U,33)_U_+$PIECE(PT,U,34)_U_+$PIECE(PT,U,35)_U_+$PIECE(PT,U,36)
- +24 IF '$DATA(^TMP($JOB,"ECXAUD",DIV,DFN))
- SET ^TMP($JOB,"ECXAUD",DIV,DFN)="0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0^0"
- +25 SET TMP=^TMP($JOB,"ECXAUD",DIV,DFN)
- +26 FOR JJ=1:1:24
- SET $PIECE(TMP,U,JJ)=$PIECE(TMP,U,JJ)+$PIECE(DATA,U,JJ)
- +27 SET ^TMP($JOB,"ECXAUD",DIV,DFN)=TMP
- SET CNT=CNT+1
- +28 IF $DATA(ZTQUEUED)
- IF (CNT>499)
- IF '(CNT#500)
- IF $$S^%ZTLOAD
- SET QQFLG=1
- SET ZTSTOP=1
- KILL ZTREQ
- QUIT
- End DoDot:1
- if QQFLG
- QUIT
- +29 ;after all dental extract records processed, then do totals by patient and procedure
- +30 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- KILL ZTREQ
- QUIT
- +31 SET DIV=""
- FOR
- SET DIV=$ORDER(DIV(DIV))
- if DIV=""
- QUIT
- SET TOTPTS(DIV)=0
- FOR JJ=1:1:24
- SET ^TMP($JOB,"ECXPROC",DIV,JJ)=0
- SET ^TMP($JOB,"ECXPATS",DIV,JJ)=0
- +32 SET DIV=""
- FOR
- SET DIV=$ORDER(^TMP($JOB,"ECXAUD",DIV))
- if DIV=""
- QUIT
- Begin DoDot:1
- +33 SET DFN=""
- FOR
- SET DFN=$ORDER(^TMP($JOB,"ECXAUD",DIV,DFN))
- if DFN=""
- QUIT
- Begin DoDot:2
- +34 SET TMP=^TMP($JOB,"ECXAUD",DIV,DFN)
- SET TOTPTS(DIV)=TOTPTS(DIV)+1
- +35 FOR JJ=1:1:24
- SET ^TMP($JOB,"ECXPROC",DIV,JJ)=^TMP($JOB,"ECXPROC",DIV,JJ)+$PIECE(TMP,U,JJ)
- IF +$PIECE(TMP,U,JJ)>0
- SET ^TMP($JOB,"ECXPATS",DIV,JJ)=^TMP($JOB,"ECXPATS",DIV,JJ)+1
- End DoDot:2
- End DoDot:1
- +36 ;print the report
- +37 DO PRINT
- +38 DO AUDIT^ECXKILL
- +39 QUIT
- +40 ;
- PRINT ;print the DEN audit report by dental site
- +1 NEW LN,P,PG,SS,QFLG,GTPROC,GTPAT,TPROC,TPAT,DIEN,TEXT
- +2 USE IO
- +3 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- SET ZTSTOP=1
- KILL ZTREQ
- QUIT
- +4 SET (QFLG,PG)=0
- SET $PIECE(LN,"-",80)=""
- SET DIV=""
- +5 FOR
- SET DIV=$ORDER(^TMP($JOB,"ECXPROC",DIV))
- if DIV=""
- QUIT
- SET DIEN=DIV(DIV)
- Begin DoDot:1
- +6 SET (GTPROC,GTPAT)=0
- +7 DO HEADER
- if QFLG
- QUIT
- +8 IF TOTPTS(DIV)=0
- Begin DoDot:2
- +9 WRITE !!,?28,"No data for Dental Site "_$PIECE(ECXDIV(DIEN),U,3)_".",!
- End DoDot:2
- QUIT
- +10 SET GTPAT=TOTPTS(DIV)
- +11 FOR P=1:1:24
- Begin DoDot:2
- +12 SET TEXT=$TEXT(DENT+P)
- SET TEXT=$PIECE(TEXT,";;",2)
- SET TPROC=^TMP($JOB,"ECXPROC",DIV,P)
- SET TPAT=^TMP($JOB,"ECXPATS",DIV,P)
- SET GTPROC=GTPROC+TPROC
- +13 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- +14 WRITE !,$EXTRACT($PIECE(TEXT,U,1),1,25),?28,$EXTRACT($PIECE(TEXT,U,2),1,25),?56,$$RJ^XLFSTR(TPROC,5," "),?70,$$RJ^XLFSTR(TPAT,5," ")
- End DoDot:2
- if QFLG
- QUIT
- +15 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !!
- +16 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !,?56,"-----",?70,"-----"
- +17 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !,"Totals for Dental Site "_$PIECE(ECXDIV(DIEN),U,3)_":",?56,$$RJ^XLFSTR(GTPROC,5," "),?70,$$RJ^XLFSTR(GTPAT,5," ")," **"
- +18 if ($Y+3>IOSL)
- DO HEADER
- if QFLG
- QUIT
- WRITE !!,"** Total # of unique patients.",!
- End DoDot:1
- if QFLG
- QUIT
- +19 IF $EXTRACT(IOST)'="C"
- Begin DoDot:1
- +20 WRITE @IOF
- SET PG=PG+1
- +21 WRITE !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- +22 WRITE !,"DSS Extract Log #: "_ECXEXT
- +23 WRITE !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- +24 WRITE !,"Report Run Date/Time: "_ECXRUN,?70,"Page: ",PG
- +25 WRITE !!,LN,!!
- +26 SET DIC="^ECX(727.1,"
- SET DA=ECXARRAY("DEF")
- SET DR="1"
- DO EN^DIQ
- +27 WRITE @IOF
- End DoDot:1
- +28 IF $EXTRACT(IOST)="C"
- IF 'QFLG
- Begin DoDot:1
- +29 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +30 SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- End DoDot:1
- +31 QUIT
- +32 ;
- +1 NEW JJ,SS
- +2 IF $EXTRACT(IOST)="C"
- Begin DoDot:1
- +3 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +4 IF PG>0
- SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- if 'Y
- SET QFLG=1
- End DoDot:1
- +5 if QFLG
- QUIT
- +6 if $Y!($EXTRACT(IOST)="C")
- WRITE @IOF
- SET PG=PG+1
- +7 WRITE !,ECXARRAY("TYPE")_" ("_ECXHEAD_") Extract Audit Report"
- +8 WRITE !,"DSS Extract Log #: "_ECXEXT
- +9 WRITE !,"Date Range of Audit: "_ECXARRAY("START")_" to "_ECXARRAY("END")
- +10 WRITE !,"Report Run Date/Time: "_ECXRUN
- +11 IF $PIECE(ECXDIV(DIEN),U,2)=""
- SET $PIECE(ECXDIV(DIEN),U,2)="Unknown"
- +12 WRITE !,"Dental Site: "_$PIECE(ECXDIV(DIEN),U,3)_" ("_$PIECE(ECXDIV(DIEN),U,2)_")",?70,"Page: "_PG
- +13 WRITE !!,?56,"# of",?70,"# of"
- +14 WRITE !,"DSS Procedure",?28,"Dental Procedure",?56,"Procedures",?70,"Patients"
- +15 WRITE !,LN,!
- +16 QUIT
- +17 ;
- DENT ;;procedure names for report
- +1 ;;Screening Exam^ SCREENING EXAMINATION
- +2 ;;Complete Exam^ COMPLETE EXAMINATION
- +3 ;;Evaluation^ EVALUATION
- +4 ;;X-Rays Extraoral^ DIAGNOSTIC FILMS-EXTRAORAL
- +5 ;;X-Rays Intraoral^ DIAGNOSTIC FILMS-INTRAORAL
- +6 ;;Neoplasm Confirmed Malignant^ MALIGNANT NEOPLASM CONFIRMED
- +7 ;;Surfaces Restored^ SURFACE RESTORED
- +8 ;;Root Canal Therapy^ ROOT CANAL FILLED
- +9 ;;Periodontal Quads (Surgical)^ QUADRANT OF PERIODONTAL SURGERY
- +10 ;;Periodontal Quads (Root Plane)^ QUADRANT OF ROOT PLANING AND CURETTAGE
- +11 ;;Prophy Natural Dentition^ PROPHYLAXIS - NATURAL DENTITION
- +12 ;;Prophy Denture^ PATIENT WITH PROTHESES CLEANED
- +13 ;;Extractions^ EXTRACTIONS (WEIGHTED)
- +14 ;;Surgical Extractions^ SURGICAL EXTRACTION
- +15 ;;Neoplasm Removed^ NEOPLASM REMOVED
- +16 ;;Biopsy/Smear^ BIOPSY AND/OR CYTOLOGICAL SMEARS
- +17 ;;Fracture^ MAXILLOFACIAL FRACTURE REDUCTION
- +18 ;;Individual Crowns^ SINGLE CROWN (PER CROWN)
- +19 ;;Post & Cores^ POST AND CORE OR OVERDENTURE COPING
- +20 ;;Fixed Partials (Abut)^ ABUTMENT UNIT FOR FIXED PROSTHESIS
- +21 ;;Fixed Partials (Pont Only)^ PONTIC UNIT FOR FIXED PROSTHESIS
- +22 ;;Removable Partials^ REMOVABLE PARTIAL DENTURE INSERTED
- +23 ;;Complete Dentures^ REMOVABLE COMPLETE DENTURE INSERTED
- +24 ;;Prosthetic Repair^ PROTHESIS REPAIRED