ECRPCLS ;ALB/JAP - Event Capture Invalid Provider Report ;12/10/12 16:10
;;2.0;EVENT CAPTURE;**5,47,119**;8 May 96;Build 12
;
EN ;entry point from menu option
W !
D RANGE
I '$G(ECLOOP)!'$G(ECBEGIN)!'$G(ECEND) G EXIT
W !
D SORT
I $G(DIRUT) G EXIT
I "PR"'[$G(ECSORT) G EXIT
K DIR,DIRUT,DUOUT
W !
D DEVICE
I POP G EXIT
I $G(ZTSK) G EXIT
I $G(IO("Q")),'$G(ZTSK) G EXIT
D START
D HOME^%ZIS
G EXIT
;
START ;queued entry point or continuation
D PROCESS
I $G(ECPTYP)="E" D EXPORT,EXIT Q ;119 Export to excel
U IO D PRINT
I $D(ECGUI) D EXIT Q
I IO'=IO(0) D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@" D EXIT
Q
;
RANGE ;get any date range between T and T-365
N X1,X2,ECSTDT,ECENDDT
W !,?5,"Enter a Begin Date and End Date for this Event Capture "
W !,?5,"provider report -- both dates must be within the past "
W !,?5,"365 days.",!
S (ECBEGIN,ECEND)=0
F D Q:ECBEGIN>0 Q:'$G(ECLOOP)
.S ECLOOP=$$STDT^ECRUTL() I 'ECLOOP Q
.S ECBEGIN=ECSTDT
.S X1=DT,X2=ECBEGIN D ^%DTC I X>365 D
..W !!,?15,"The Begin Date for this report may not be"
..W !,?15,"more than 365 days ago. Try again...",!
..S ECBEGIN=0
Q:'$G(ECLOOP)!'$G(ECBEGIN)
F D Q:ECEND>0 Q:'$G(ECLOOP)
.S ECLOOP=$$ENDDT^ECRUTL(ECSTDT) I 'ECLOOP Q
.S ECEND=ECENDDT
.I ECEND>(DT+1) D
..W !!,?15,"The End Date for this report may not be"
..W !,?15,"a future date. Try again...",!
..S ECEND=0
Q
;
SORT ;ask user if report should be alpha by patient (P) or
; alpha by provider (R)
K DIR
S DIR(0)="SAXB^P:PATIENT;R:PROVIDER"
S DIR("?")="Enter an uppercase 'P' or 'R'."
S DIR("A")="Select sorting by Patient or pRovider (P/R): "
S DIR("A",1)=" "
S DIR("A",2)="If you want the report to show Patient name in the 1st column,"
S DIR("A",3)="enter a 'P'. The listing will be alphabetical by Patient name."
S DIR("A",4)=" "
S DIR("A",5)="If you want the report to show Provider name in the 1st column,"
S DIR("A",6)="enter an 'R'. The listing will be alphabetical by Provider name."
S DIR("A",7)=" "
D ^DIR
Q:$G(DIRUT)
S ECSORT=Y
Q
;
DEVICE ;get device and queue
K IOP S %ZIS="QM" D ^%ZIS
I POP W !!,"No device selected. Exiting...",!! S DIR(0)="E" W ! D ^DIR K DIR Q
I $D(IO("Q")) D
.S ZTRTN="START^ECRPCLS",ZTDESC="EC Invalid Provider Report"
.S ZTSAVE("ECBEGIN")="",ZTSAVE("ECEND")="",ZTSAVE("ECSORT")=""
.D ^%ZTLOAD
.I '$G(ZTSK) W !,"Report canceled..." S DIR(0)="E" W ! D ^DIR K DIR Q
.W !,"Report queued as Task #: ",ZTSK S DIR(0)="E" W ! D ^DIR K DIR
Q
;
PROCESS ;process the "AC" x-ref in file #721
;^ECH("AC",date,file#721 ien)=""
;$ORDER from begindate to enddate
;use $$GET^XUA4A72(provider ien,date)
;if return is >0 then get next x-ref entry
;
N ECD,ECDATA,ECDATE,ECDDT,ECDT,ECERR,ECIEN,ECPIEN,ECPRDT,ECPRIEN,ECPRVN,ECPT,ECPTN,ECS,ECSSN,ECT,ECU,ECU2,ECU3
K ^TMP("ECRPCLS",$J) S ECDT=ECBEGIN
F S ECDT=$O(^ECH("AC",ECDT)) Q:ECDT>ECEND Q:ECDT="" D
.S ECIEN=""
.F S ECIEN=$O(^ECH("AC",ECDT,ECIEN)) Q:ECIEN="" D
..S ECDATA=$G(^ECH(ECIEN,0)) I '+ECDATA Q ;file problem
..S ECPRDT=$P(ECDT,".",1),ECDDT=$P(ECDATA,"^",3) I ECDDT'=ECDT S ECPRDT=$P(ECDDT,".",1) ;there's a problem in the x-ref
..I ECPRDT<ECBEGIN!(ECPRDT>ECEND) Q
..S ECU=$P(ECDATA,"^",11),ECU2=$P(ECDATA,"^",15),ECU3=$P(ECDATA,"^",17)
..F ECPIEN=ECU,ECU2,ECU3 D
...Q:'+ECPIEN
...S ECERR=$$GET^XUA4A72(ECPIEN,ECPRDT) Q:+ECERR>0
...S ECD=$P(ECDDT,".",1),ECT=$P(ECDDT,".",2)
...S ECDATE=$E(ECD,4,5)_"/"_$E(ECD,6,7)_"/"_$E(ECD,2,3) I +ECT S ECT=$$LJ^XLFSTR(ECT,4,0),ECDATE=ECDATE_" "_$E(ECT,1,2)_":"_$E(ECT,3,4)
...S ECPT=$P(ECDATA,"^",2),ECPTN=$P($G(^DPT(ECPT,0)),"^",1) Q:ECPTN=""
...S ECS=$P(^(0),"^",9),ECS=$E(ECS,1,9),ECSSN=$E(ECS,6,9)
...S ECPRVN=$P($G(^VA(200,ECPIEN,0)),"^",1) Q:ECPRVN=""
...S ECPRIEN="("_ECPIEN_")",ECPRIEN=$$RJ^XLFSTR(ECPRIEN,10," ")
...;if sort by patient then patient name is 3rd subscript
...I ECSORT="P" S ^TMP("ECRPCLS",$J,ECPTN,ECPRVN,ECIEN)=ECERR_"^"_ECPRIEN_"^"_ECSSN_"^"_ECDATE
...;if sort by provider then provider name is 3rd subscript
...I ECSORT="R" S ^TMP("ECRPCLS",$J,ECPRVN,ECPTN,ECIEN)=ECERR_"^"_ECPRIEN_"^"_ECSSN_"^"_ECDATE
Q
;
PRINT ;output report
;
N X1,X2,PROVIDER,PATIENT,PAGE,PRNTDT,QFLAG,DASH,JJ,SS
N ECDATA,ECDATE,ECERR,ECIEN,ECPRIEN,ECPRVN,ECPTN,ECSSN
S (PAGE,QFLAG)=0 S $P(DASH,"-",80)=""
S Y=$P(ECBEGIN,".",1)+1 D DD^%DT S ECBEGIN=Y S Y=$P(ECEND,".",1) D DD^%DT S ECEND=Y
D NOW^%DTC S Y=$E(%,1,12) D DD^%DT S PRNTDT=Y
D HEAD
I '$D(^TMP("ECRPCLS",$J)) D Q
.W !!,?12,"No invalid providers found for date range specified."
.I $E(IOST)="C"&('QFLAG) S DIR(0)="E" D D ^DIR K DIR
..S SS=22-$Y F JJ=1:1:SS W !
.W:$E(IOST)'="C" @IOF
S X1="" F S X1=$O(^TMP("ECRPCLS",$J,X1)) Q:X1="" D
.S:ECSORT="P" ECPTN=X1 S:ECSORT="R" ECPRVN=X1
.S X2="" F S X2=$O(^TMP("ECRPCLS",$J,X1,X2)) Q:X2="" D
..S:ECSORT="P" ECPRVN=X2 S:ECSORT="R" ECPTN=X2
..S ECIEN="",ECIEN=$O(^TMP("ECRPCLS",$J,X1,X2,ECIEN)),ECDATA=^(ECIEN)
..S ECERR=$P(ECDATA,"^",1),ECPRIEN=$P(ECDATA,"^",2),ECSSN=$P(ECDATA,"^",3),ECDATE=$P(ECDATA,"^",4)
..S PROVIDER=$$LJ^XLFSTR($E(ECPRVN,1,20),20," ")_" "_ECPRIEN_" "_ECERR
..S PATIENT=$$LJ^XLFSTR($E(ECPTN,1,20),20," ")_" "_ECSSN_" "_ECDATE
..D:($Y+3>IOSL) HEAD
..I ECSORT="P" W !,PATIENT_" "_PROVIDER
..I ECSORT="R" W !,PROVIDER_" "_PATIENT
I $E(IOST)="C"&('QFLAG) S DIR(0)="E" D D ^DIR W @IOF
.S SS=22-$Y F JJ=1:1:SS W !
W:$E(IOST)'="C" @IOF
Q
;
HEAD ;report header
;write the header line with page # and print date and explanation
I $E(IOST)="C" S SS=22-$Y F JJ=1:1:SS W !
I $E(IOST)="C",PAGE>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLAG=1 Q
W:$Y!($E(IOST)="C") @IOF
S PAGE=PAGE+1
W !,?12,"Event Capture Providers with Inactive/Missing Person Class"
W !,?12,"for the Date Range "_ECBEGIN_" through "_ECEND
W !!,"Printed: "_PRNTDT,?65,"Page: "_PAGE,!
I PAGE=1 D
.W !,?12,"The following entries in the Event Capture Patient file (#721)"
.W !,?12,"are associated with a provider who meets one of the following"
.W !,?12,"criteria:",!
.W !,?22,"(a) The provider has no Person Class"
.W !,?22," specified in file #200. (Error=-1)"
.W !,?22,"(b) The provider does not have an active"
.W !,?22," Person Class in file #200 for the"
.W !,?22," date of procedure. (Error=-2)",!
.W !,?12,"The provider's record number in file #200 is shown in parentheses"
.W !,?12,"after the provider name.",!
I ECSORT="P" D SUBHDA
I ECSORT="R" D SUBHDB
Q
;
SUBHDA ;subheader for sort by patient
W !,?27,"Date of"
W !,"Patient",?21,"SSN",?27,"Procedure",?43,"Provider",?75,"Err."
W !,DASH,!
Q
;
SUBHDB ;subheader for sort by provider
W !,?65,"Date of"
W !,"Provider",?32,"Err.",?38,"Patient",?59,"SSN",?65,"Procedure"
W !,DASH,!
Q
;
EXIT ;common exit point & clean-up
D ^ECKILL
D:'$D(ECGUI) ^%ZISC
K ^TMP("ECRPCLS",$J)
K DIR,DIRUT,DTOUT,DUOUT,ECBEGIN,ECEND,ECSORT,ECLOOP
K IO("Q"),POP,X,Y,ZTSK,ZTRTN,ZTDESC,ZTSAVE
Q
;
EXPORT ;119 Put data in excel format
N X1,X2,CNT,JJ,SS,ECDATA,ECDATE,ECERR,ECIEN,ECPRIEN,ECPRVN,ECPTN,ECSSN
S CNT=1
S ^TMP($J,"ECRPT",CNT)="PATIENT NAME^SSN^PROCEDURE DATE^PROVIDER NAME^PROVIDER IEN #^ERROR"
I '$D(^TMP("ECRPCLS",$J)) Q ;no data to export
S X1="" F S X1=$O(^TMP("ECRPCLS",$J,X1)) Q:X1="" D
.S:ECSORT="P" ECPTN=X1 S:ECSORT="R" ECPRVN=X1
.S X2="" F S X2=$O(^TMP("ECRPCLS",$J,X1,X2)) Q:X2="" D
..S:ECSORT="P" ECPRVN=X2 S:ECSORT="R" ECPTN=X2
..S ECIEN="",ECIEN=$O(^TMP("ECRPCLS",$J,X1,X2,ECIEN)),ECDATA=^(ECIEN)
..S ECERR=$P(ECDATA,"^",1),ECPRIEN=$P(ECDATA,"^",2),ECSSN=$P(ECDATA,"^",3),ECDATE=$P(ECDATA,"^",4)
..S CNT=CNT+1,^TMP($J,"ECRPT",CNT)=ECPTN_U_ECSSN_U_ECDATE_U_ECPRVN_U_+$TR(ECPRIEN," ()","")_U_$S(ECERR=-1:"No Person Class",1:"Person class not active on procedure date")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECRPCLS 7875 printed Apr 09, 2024@21:00:44 Page 2
ECRPCLS ;ALB/JAP - Event Capture Invalid Provider Report ;12/10/12 16:10
+1 ;;2.0;EVENT CAPTURE;**5,47,119**;8 May 96;Build 12
+2 ;
EN ;entry point from menu option
+1 WRITE !
+2 DO RANGE
+3 IF '$GET(ECLOOP)!'$GET(ECBEGIN)!'$GET(ECEND)
GOTO EXIT
+4 WRITE !
+5 DO SORT
+6 IF $GET(DIRUT)
GOTO EXIT
+7 IF "PR"'[$GET(ECSORT)
GOTO EXIT
+8 KILL DIR,DIRUT,DUOUT
+9 WRITE !
+10 DO DEVICE
+11 IF POP
GOTO EXIT
+12 IF $GET(ZTSK)
GOTO EXIT
+13 IF $GET(IO("Q"))
IF '$GET(ZTSK)
GOTO EXIT
+14 DO START
+15 DO HOME^%ZIS
+16 GOTO EXIT
+17 ;
START ;queued entry point or continuation
+1 DO PROCESS
+2 ;119 Export to excel
IF $GET(ECPTYP)="E"
DO EXPORT
DO EXIT
QUIT
+3 USE IO
DO PRINT
+4 IF $DATA(ECGUI)
DO EXIT
QUIT
+5 IF IO'=IO(0)
DO ^%ZISC
+6 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
DO EXIT
+7 QUIT
+8 ;
RANGE ;get any date range between T and T-365
+1 NEW X1,X2,ECSTDT,ECENDDT
+2 WRITE !,?5,"Enter a Begin Date and End Date for this Event Capture "
+3 WRITE !,?5,"provider report -- both dates must be within the past "
+4 WRITE !,?5,"365 days.",!
+5 SET (ECBEGIN,ECEND)=0
+6 FOR
Begin DoDot:1
+7 SET ECLOOP=$$STDT^ECRUTL()
IF 'ECLOOP
QUIT
+8 SET ECBEGIN=ECSTDT
+9 SET X1=DT
SET X2=ECBEGIN
DO ^%DTC
IF X>365
Begin DoDot:2
+10 WRITE !!,?15,"The Begin Date for this report may not be"
+11 WRITE !,?15,"more than 365 days ago. Try again...",!
+12 SET ECBEGIN=0
End DoDot:2
End DoDot:1
if ECBEGIN>0
QUIT
if '$GET(ECLOOP)
QUIT
+13 if '$GET(ECLOOP)!'$GET(ECBEGIN)
QUIT
+14 FOR
Begin DoDot:1
+15 SET ECLOOP=$$ENDDT^ECRUTL(ECSTDT)
IF 'ECLOOP
QUIT
+16 SET ECEND=ECENDDT
+17 IF ECEND>(DT+1)
Begin DoDot:2
+18 WRITE !!,?15,"The End Date for this report may not be"
+19 WRITE !,?15,"a future date. Try again...",!
+20 SET ECEND=0
End DoDot:2
End DoDot:1
if ECEND>0
QUIT
if '$GET(ECLOOP)
QUIT
+21 QUIT
+22 ;
SORT ;ask user if report should be alpha by patient (P) or
+1 ; alpha by provider (R)
+2 KILL DIR
+3 SET DIR(0)="SAXB^P:PATIENT;R:PROVIDER"
+4 SET DIR("?")="Enter an uppercase 'P' or 'R'."
+5 SET DIR("A")="Select sorting by Patient or pRovider (P/R): "
+6 SET DIR("A",1)=" "
+7 SET DIR("A",2)="If you want the report to show Patient name in the 1st column,"
+8 SET DIR("A",3)="enter a 'P'. The listing will be alphabetical by Patient name."
+9 SET DIR("A",4)=" "
+10 SET DIR("A",5)="If you want the report to show Provider name in the 1st column,"
+11 SET DIR("A",6)="enter an 'R'. The listing will be alphabetical by Provider name."
+12 SET DIR("A",7)=" "
+13 DO ^DIR
+14 if $GET(DIRUT)
QUIT
+15 SET ECSORT=Y
+16 QUIT
+17 ;
DEVICE ;get device and queue
+1 KILL IOP
SET %ZIS="QM"
DO ^%ZIS
+2 IF POP
WRITE !!,"No device selected. Exiting...",!!
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
QUIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="START^ECRPCLS"
SET ZTDESC="EC Invalid Provider Report"
+5 SET ZTSAVE("ECBEGIN")=""
SET ZTSAVE("ECEND")=""
SET ZTSAVE("ECSORT")=""
+6 DO ^%ZTLOAD
+7 IF '$GET(ZTSK)
WRITE !,"Report canceled..."
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
QUIT
+8 WRITE !,"Report queued as Task #: ",ZTSK
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
End DoDot:1
+9 QUIT
+10 ;
PROCESS ;process the "AC" x-ref in file #721
+1 ;^ECH("AC",date,file#721 ien)=""
+2 ;$ORDER from begindate to enddate
+3 ;use $$GET^XUA4A72(provider ien,date)
+4 ;if return is >0 then get next x-ref entry
+5 ;
+6 NEW ECD,ECDATA,ECDATE,ECDDT,ECDT,ECERR,ECIEN,ECPIEN,ECPRDT,ECPRIEN,ECPRVN,ECPT,ECPTN,ECS,ECSSN,ECT,ECU,ECU2,ECU3
+7 KILL ^TMP("ECRPCLS",$JOB)
SET ECDT=ECBEGIN
+8 FOR
SET ECDT=$ORDER(^ECH("AC",ECDT))
if ECDT>ECEND
QUIT
if ECDT=""
QUIT
Begin DoDot:1
+9 SET ECIEN=""
+10 FOR
SET ECIEN=$ORDER(^ECH("AC",ECDT,ECIEN))
if ECIEN=""
QUIT
Begin DoDot:2
+11 ;file problem
SET ECDATA=$GET(^ECH(ECIEN,0))
IF '+ECDATA
QUIT
+12 ;there's a problem in the x-ref
SET ECPRDT=$PIECE(ECDT,".",1)
SET ECDDT=$PIECE(ECDATA,"^",3)
IF ECDDT'=ECDT
SET ECPRDT=$PIECE(ECDDT,".",1)
+13 IF ECPRDT<ECBEGIN!(ECPRDT>ECEND)
QUIT
+14 SET ECU=$PIECE(ECDATA,"^",11)
SET ECU2=$PIECE(ECDATA,"^",15)
SET ECU3=$PIECE(ECDATA,"^",17)
+15 FOR ECPIEN=ECU,ECU2,ECU3
Begin DoDot:3
+16 if '+ECPIEN
QUIT
+17 SET ECERR=$$GET^XUA4A72(ECPIEN,ECPRDT)
if +ECERR>0
QUIT
+18 SET ECD=$PIECE(ECDDT,".",1)
SET ECT=$PIECE(ECDDT,".",2)
+19 SET ECDATE=$EXTRACT(ECD,4,5)_"/"_$EXTRACT(ECD,6,7)_"/"_$EXTRACT(ECD,2,3)
IF +ECT
SET ECT=$$LJ^XLFSTR(ECT,4,0)
SET ECDATE=ECDATE_" "_$EXTRACT(ECT,1,2)_":"_$EXTRACT(ECT,3,4)
+20 SET ECPT=$PIECE(ECDATA,"^",2)
SET ECPTN=$PIECE($GET(^DPT(ECPT,0)),"^",1)
if ECPTN=""
QUIT
+21 SET ECS=$PIECE(^(0),"^",9)
SET ECS=$EXTRACT(ECS,1,9)
SET ECSSN=$EXTRACT(ECS,6,9)
+22 SET ECPRVN=$PIECE($GET(^VA(200,ECPIEN,0)),"^",1)
if ECPRVN=""
QUIT
+23 SET ECPRIEN="("_ECPIEN_")"
SET ECPRIEN=$$RJ^XLFSTR(ECPRIEN,10," ")
+24 ;if sort by patient then patient name is 3rd subscript
+25 IF ECSORT="P"
SET ^TMP("ECRPCLS",$JOB,ECPTN,ECPRVN,ECIEN)=ECERR_"^"_ECPRIEN_"^"_ECSSN_"^"_ECDATE
+26 ;if sort by provider then provider name is 3rd subscript
+27 IF ECSORT="R"
SET ^TMP("ECRPCLS",$JOB,ECPRVN,ECPTN,ECIEN)=ECERR_"^"_ECPRIEN_"^"_ECSSN_"^"_ECDATE
End DoDot:3
End DoDot:2
End DoDot:1
+28 QUIT
+29 ;
PRINT ;output report
+1 ;
+2 NEW X1,X2,PROVIDER,PATIENT,PAGE,PRNTDT,QFLAG,DASH,JJ,SS
+3 NEW ECDATA,ECDATE,ECERR,ECIEN,ECPRIEN,ECPRVN,ECPTN,ECSSN
+4 SET (PAGE,QFLAG)=0
SET $PIECE(DASH,"-",80)=""
+5 SET Y=$PIECE(ECBEGIN,".",1)+1
DO DD^%DT
SET ECBEGIN=Y
SET Y=$PIECE(ECEND,".",1)
DO DD^%DT
SET ECEND=Y
+6 DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET PRNTDT=Y
+7 DO HEAD
+8 IF '$DATA(^TMP("ECRPCLS",$JOB))
Begin DoDot:1
+9 WRITE !!,?12,"No invalid providers found for date range specified."
+10 IF $EXTRACT(IOST)="C"&('QFLAG)
SET DIR(0)="E"
Begin DoDot:2
+11 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
End DoDot:2
DO ^DIR
KILL DIR
+12 if $EXTRACT(IOST)'="C"
WRITE @IOF
End DoDot:1
QUIT
+13 SET X1=""
FOR
SET X1=$ORDER(^TMP("ECRPCLS",$JOB,X1))
if X1=""
QUIT
Begin DoDot:1
+14 if ECSORT="P"
SET ECPTN=X1
if ECSORT="R"
SET ECPRVN=X1
+15 SET X2=""
FOR
SET X2=$ORDER(^TMP("ECRPCLS",$JOB,X1,X2))
if X2=""
QUIT
Begin DoDot:2
+16 if ECSORT="P"
SET ECPRVN=X2
if ECSORT="R"
SET ECPTN=X2
+17 SET ECIEN=""
SET ECIEN=$ORDER(^TMP("ECRPCLS",$JOB,X1,X2,ECIEN))
SET ECDATA=^(ECIEN)
+18 SET ECERR=$PIECE(ECDATA,"^",1)
SET ECPRIEN=$PIECE(ECDATA,"^",2)
SET ECSSN=$PIECE(ECDATA,"^",3)
SET ECDATE=$PIECE(ECDATA,"^",4)
+19 SET PROVIDER=$$LJ^XLFSTR($EXTRACT(ECPRVN,1,20),20," ")_" "_ECPRIEN_" "_ECERR
+20 SET PATIENT=$$LJ^XLFSTR($EXTRACT(ECPTN,1,20),20," ")_" "_ECSSN_" "_ECDATE
+21 if ($Y+3>IOSL)
DO HEAD
+22 IF ECSORT="P"
WRITE !,PATIENT_" "_PROVIDER
+23 IF ECSORT="R"
WRITE !,PROVIDER_" "_PATIENT
End DoDot:2
End DoDot:1
+24 IF $EXTRACT(IOST)="C"&('QFLAG)
SET DIR(0)="E"
Begin DoDot:1
+25 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
End DoDot:1
DO ^DIR
WRITE @IOF
+26 if $EXTRACT(IOST)'="C"
WRITE @IOF
+27 QUIT
+28 ;
HEAD ;report header
+1 ;write the header line with page # and print date and explanation
+2 IF $EXTRACT(IOST)="C"
SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+3 IF $EXTRACT(IOST)="C"
IF PAGE>0
SET DIR(0)="E"
WRITE !
DO ^DIR
KILL DIR
IF 'Y
SET QFLAG=1
QUIT
+4 if $Y!($EXTRACT(IOST)="C")
WRITE @IOF
+5 SET PAGE=PAGE+1
+6 WRITE !,?12,"Event Capture Providers with Inactive/Missing Person Class"
+7 WRITE !,?12,"for the Date Range "_ECBEGIN_" through "_ECEND
+8 WRITE !!,"Printed: "_PRNTDT,?65,"Page: "_PAGE,!
+9 IF PAGE=1
Begin DoDot:1
+10 WRITE !,?12,"The following entries in the Event Capture Patient file (#721)"
+11 WRITE !,?12,"are associated with a provider who meets one of the following"
+12 WRITE !,?12,"criteria:",!
+13 WRITE !,?22,"(a) The provider has no Person Class"
+14 WRITE !,?22," specified in file #200. (Error=-1)"
+15 WRITE !,?22,"(b) The provider does not have an active"
+16 WRITE !,?22," Person Class in file #200 for the"
+17 WRITE !,?22," date of procedure. (Error=-2)",!
+18 WRITE !,?12,"The provider's record number in file #200 is shown in parentheses"
+19 WRITE !,?12,"after the provider name.",!
End DoDot:1
+20 IF ECSORT="P"
DO SUBHDA
+21 IF ECSORT="R"
DO SUBHDB
+22 QUIT
+23 ;
SUBHDA ;subheader for sort by patient
+1 WRITE !,?27,"Date of"
+2 WRITE !,"Patient",?21,"SSN",?27,"Procedure",?43,"Provider",?75,"Err."
+3 WRITE !,DASH,!
+4 QUIT
+5 ;
SUBHDB ;subheader for sort by provider
+1 WRITE !,?65,"Date of"
+2 WRITE !,"Provider",?32,"Err.",?38,"Patient",?59,"SSN",?65,"Procedure"
+3 WRITE !,DASH,!
+4 QUIT
+5 ;
EXIT ;common exit point & clean-up
+1 DO ^ECKILL
+2 if '$DATA(ECGUI)
DO ^%ZISC
+3 KILL ^TMP("ECRPCLS",$JOB)
+4 KILL DIR,DIRUT,DTOUT,DUOUT,ECBEGIN,ECEND,ECSORT,ECLOOP
+5 KILL IO("Q"),POP,X,Y,ZTSK,ZTRTN,ZTDESC,ZTSAVE
+6 QUIT
+7 ;
EXPORT ;119 Put data in excel format
+1 NEW X1,X2,CNT,JJ,SS,ECDATA,ECDATE,ECERR,ECIEN,ECPRIEN,ECPRVN,ECPTN,ECSSN
+2 SET CNT=1
+3 SET ^TMP($JOB,"ECRPT",CNT)="PATIENT NAME^SSN^PROCEDURE DATE^PROVIDER NAME^PROVIDER IEN #^ERROR"
+4 ;no data to export
IF '$DATA(^TMP("ECRPCLS",$JOB))
QUIT
+5 SET X1=""
FOR
SET X1=$ORDER(^TMP("ECRPCLS",$JOB,X1))
if X1=""
QUIT
Begin DoDot:1
+6 if ECSORT="P"
SET ECPTN=X1
if ECSORT="R"
SET ECPRVN=X1
+7 SET X2=""
FOR
SET X2=$ORDER(^TMP("ECRPCLS",$JOB,X1,X2))
if X2=""
QUIT
Begin DoDot:2
+8 if ECSORT="P"
SET ECPRVN=X2
if ECSORT="R"
SET ECPTN=X2
+9 SET ECIEN=""
SET ECIEN=$ORDER(^TMP("ECRPCLS",$JOB,X1,X2,ECIEN))
SET ECDATA=^(ECIEN)
+10 SET ECERR=$PIECE(ECDATA,"^",1)
SET ECPRIEN=$PIECE(ECDATA,"^",2)
SET ECSSN=$PIECE(ECDATA,"^",3)
SET ECDATE=$PIECE(ECDATA,"^",4)
+11 SET CNT=CNT+1
SET ^TMP($JOB,"ECRPT",CNT)=ECPTN_U_ECSSN_U_ECDATE_U_ECPRVN_U_+$TRANSLATE(ECPRIEN," ()","")_U_$SELECT(ECERR=-1:"No Person Class",1:"Person class not active on procedure date")
End DoDot:2
End DoDot:1
+12 QUIT
