- 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 Feb 18, 2025@23:25:02 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
