BQICARPT ;VNGT/HS/ALA-CANES Export Report ; 15 Nov 2010 2:59 PM
;;2.1;ICARE MANAGEMENT SYSTEM;**1**;Feb 07, 2011;Build 5
;
;
EN ;
NEW ABORT,BQIBDT,BQIEDT,BQISTDT,BQIENDT,BQIRUN,ZTDESC,ZTRTN,ZTIO,ZTSAVE
NEW BXIEN,CT,DATA,DATE,DFN,DXN,EVDT,HRN,L,P,POP,RCN,STAT,TOTAL,TXT,X,Y
NEW %ZIS,DTOUT,DUOUT,ZTREQ
K DIR
S BQIBDT=$O(^BQI(90507.7,"B","")),BQIEDT=$O(^BQI(90507.7,"B",""),-1)
S DIR(0)="DA^"_BQIBDT_":"_$S(BQIEDT]"":BQIEDT,1:DT)_":EX"
S DIR("A")="Please select Report START date: "
I BQIBDT]"" S DIR("B")=$$FMTE^XLFDT(BQIBDT,"1Z")
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q
S:Y>0 BQISTDT=Y
K DIR
S DIR(0)="DA^"_BQISTDT_":"_$S(BQIEDT]"":BQIEDT,1:DT)_":EX"
S DIR("A")="Please select Report END date: "
I BQIEDT]"" S DIR("B")=$$FMTE^XLFDT(BQIEDT,"1Z")
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q
S:Y>0 BQIENDT=Y
K DIR
S BQIRUN=$$HTE^XLFDT($H,1)
S ZTDESC="CANES EXPORT REPORT",ZTRTN="BEG^BQICARPT"
S %ZIS="QM" D ^%ZIS G END:POP
I '$D(IO("Q")) K ZTDESC G @ZTRTN
S ZTIO=ION,ZTSAVE("*")=""
D ^%ZTLOAD
;
END ;
Q
;
BEG ; Begin the report
S (P,L,ABORT,CT)=0
U IO D HDR I $G(ABORT)=1 Q
S BQISTDT=BQISTDT-.005
F S BQISTDT=$O(^BQI(90507.7,"B",BQISTDT)) Q:BQISTDT=""!(BQISTDT>BQIENDT) D Q:$G(ABORT)=1
. S BXIEN=""
. F S BXIEN=$O(^BQI(90507.7,"B",BQISTDT,BXIEN)) Q:BXIEN="" D Q:$G(ABORT)=1
.. S TOTAL=$P(^BQI(90507.7,BXIEN,0),U,4)
.. S STAT=$$GET1^DIQ(90507.7,BXIEN_",",.03,"E")
.. I L+4>IOSL D HDR Q:$G(ABORT)=1
.. W !,$$FMTE^BQIUL1(BQISTDT),?20,$J(TOTAL,3),?26,STAT S L=L+1
.. I TOTAL=0 Q
.. ;
.. S RCN=0
.. F S RCN=$O(^BQI(90507.7,BXIEN,10,RCN)) Q:'RCN D Q:$G(ABORT)=1
... S DATA=^BQI(90507.7,BXIEN,10,RCN,0)
... S DFN=$P(DATA,U,1),DATE=$P(DATA,U,8),DXN=$P(DATA,U,6),TXT=$P(DATA,U,7)
... S HRN=$$HRN^BQIULPT(DFN),EVDT=$$FMTE^BQIUL1(DATE)
... W !,?5,HRN,?17,EVDT,?30,DXN,?38,TXT
... S L=L+1
... I L+4>IOSL D HDR Q:$G(ABORT)=1
;
I '$G(ABORT) W !,"<End of Report>" I $E(IOST,1,2)="C-" W " Enter RETURN to continue" R Y:300
D ^%ZISC
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
HDR ; Header
I $E(IOST,1,2)="C-",P R !,"Enter RETURN to continue or '^' to exit: ",Y:300 I Y[U S ABORT=1 Q
I $E(IOST,1,2)="C-"!P W @IOF
S P=P+1,L=5
W "CANES EXPORT REPORT",?90,"Run Date: ",BQIRUN,?124,"Page ",$J(P,3)
W !,"Export Date",?15,"Total Records",?30,"Status"
W !,?2,"Patient HRN",?17,"Event Date",?30,"Diagnosis"
W !,$TR($J(" ",IOM)," ","-"),!
Q
BQICARPT ;VNGT/HS/ALA-CANES Export Report ; 15 Nov 2010 2:59 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;**1**;Feb 07, 2011;Build 5
+2 ;
+3 ;
EN ;
+1 NEW ABORT,BQIBDT,BQIEDT,BQISTDT,BQIENDT,BQIRUN,ZTDESC,ZTRTN,ZTIO,ZTSAVE
+2 NEW BXIEN,CT,DATA,DATE,DFN,DXN,EVDT,HRN,L,P,POP,RCN,STAT,TOTAL,TXT,X,Y
+3 NEW %ZIS,DTOUT,DUOUT,ZTREQ
+4 KILL DIR
+5 SET BQIBDT=$ORDER(^BQI(90507.7,"B",""))
SET BQIEDT=$ORDER(^BQI(90507.7,"B",""),-1)
+6 SET DIR(0)="DA^"_BQIBDT_":"_$SELECT(BQIEDT]"":BQIEDT,1:DT)_":EX"
+7 SET DIR("A")="Please select Report START date: "
+8 IF BQIBDT]""
SET DIR("B")=$$FMTE^XLFDT(BQIBDT,"1Z")
+9 DO ^DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+11 IF Y>0
SET BQISTDT=Y
+12 KILL DIR
+13 SET DIR(0)="DA^"_BQISTDT_":"_$SELECT(BQIEDT]"":BQIEDT,1:DT)_":EX"
+14 SET DIR("A")="Please select Report END date: "
+15 IF BQIEDT]""
SET DIR("B")=$$FMTE^XLFDT(BQIEDT,"1Z")
+16 DO ^DIR
+17 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+18 IF Y>0
SET BQIENDT=Y
+19 KILL DIR
+20 SET BQIRUN=$$HTE^XLFDT($HOROLOG,1)
+21 SET ZTDESC="CANES EXPORT REPORT"
SET ZTRTN="BEG^BQICARPT"
+22 SET %ZIS="QM"
DO ^%ZIS
IF POP
GOTO END
+23 IF '$DATA(IO("Q"))
KILL ZTDESC
GOTO @ZTRTN
+24 SET ZTIO=ION
SET ZTSAVE("*")=""
+25 DO ^%ZTLOAD
+26 ;
END ;
+1 QUIT
+2 ;
BEG ; Begin the report
+1 SET (P,L,ABORT,CT)=0
+2 USE IO
DO HDR
IF $GET(ABORT)=1
QUIT
+3 SET BQISTDT=BQISTDT-.005
+4 FOR
SET BQISTDT=$ORDER(^BQI(90507.7,"B",BQISTDT))
IF BQISTDT=""!(BQISTDT>BQIENDT)
QUIT
Begin DoDot:1
+5 SET BXIEN=""
+6 FOR
SET BXIEN=$ORDER(^BQI(90507.7,"B",BQISTDT,BXIEN))
IF BXIEN=""
QUIT
Begin DoDot:2
+7 SET TOTAL=$PIECE(^BQI(90507.7,BXIEN,0),U,4)
+8 SET STAT=$$GET1^DIQ(90507.7,BXIEN_",",.03,"E")
+9 IF L+4>IOSL
DO HDR
IF $GET(ABORT)=1
QUIT
+10 WRITE !,$$FMTE^BQIUL1(BQISTDT),?20,$JUSTIFY(TOTAL,3),?26,STAT
SET L=L+1
+11 IF TOTAL=0
QUIT
+12 ;
+13 SET RCN=0
+14 FOR
SET RCN=$ORDER(^BQI(90507.7,BXIEN,10,RCN))
IF 'RCN
QUIT
Begin DoDot:3
+15 SET DATA=^BQI(90507.7,BXIEN,10,RCN,0)
+16 SET DFN=$PIECE(DATA,U,1)
SET DATE=$PIECE(DATA,U,8)
SET DXN=$PIECE(DATA,U,6)
SET TXT=$PIECE(DATA,U,7)
+17 SET HRN=$$HRN^BQIULPT(DFN)
SET EVDT=$$FMTE^BQIUL1(DATE)
+18 WRITE !,?5,HRN,?17,EVDT,?30,DXN,?38,TXT
+19 SET L=L+1
+20 IF L+4>IOSL
DO HDR
IF $GET(ABORT)=1
QUIT
End DoDot:3
IF $GET(ABORT)=1
QUIT
End DoDot:2
IF $GET(ABORT)=1
QUIT
End DoDot:1
IF $GET(ABORT)=1
QUIT
+21 ;
+22 IF '$GET(ABORT)
WRITE !,"<End of Report>"
IF $EXTRACT(IOST,1,2)="C-"
WRITE " Enter RETURN to continue"
READ Y:300
+23 DO ^%ZISC
+24 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+25 QUIT
+26 ;
HDR ; Header
+1 IF $EXTRACT(IOST,1,2)="C-"
IF P
READ !,"Enter RETURN to continue or '^' to exit: ",Y:300
IF Y[U
SET ABORT=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"!P
WRITE @IOF
+3 SET P=P+1
SET L=5
+4 WRITE "CANES EXPORT REPORT",?90,"Run Date: ",BQIRUN,?124,"Page ",$JUSTIFY(P,3)
+5 WRITE !,"Export Date",?15,"Total Records",?30,"Status"
+6 WRITE !,?2,"Patient HRN",?17,"Event Date",?30,"Diagnosis"
+7 WRITE !,$TRANSLATE($JUSTIFY(" ",IOM)," ","-"),!
+8 QUIT
