- 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
