BGP0DICR ; IHS/CMI/LAB - ICARE LIST ;
;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
;
;
;
START ;EP
W !,$$CTR("2010 ICARE DATA ITEMS",80)
W !,$$CTR($$RPTVER^BGP0BAN,80)
INTRO ;
W !!,"This report will list all individual measures that contain iCare data"
W !,"data elements.",!
K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
I 'Y D XIT Q
ZIS ;call to XBDBQUE
K ZTSK
K IOP,%ZIS S %ZIS="PQM" D ^%ZIS I POP S IO=IO(0) Q
G:$D(IO("Q")) QUE
NOQUE ;
U IO
D PRINT
D ^%ZISC
D XIT
Q
QUE ;
K ZTSAVE S ZTSAVE("BGP*")=""
S ZTRTN="PRINT^BGP0DICR",ZTDESC="BGP 10 ICARE TEXT REPORT",ZTIO=ION,ZTDTH=""
D ^%ZTLOAD
D HOME^%ZIS
D XIT
Q
XIT ;
D EN^XBVK("BGP") I $D(ZTQUEUED) S ZTREQ="@"
D ^XBFMK
Q
;
PRINT ;
S (BGPPAGE,BGPQUIT)=0
S BGPIOSL=$S($G(BGPGUI):55,1:$G(IOSL))
D HEADER
S BGPO="" F S BGPO=$O(^BGPINDTC("AB",BGPO)) Q:BGPO=""!(BGPQUIT) D
.S BGPON="" F S BGPON=$O(^BGPINDTC("AB",BGPO,BGPON)) Q:BGPON=""!(BGPQUIT) D
..S BGPX=0 F S BGPX=$O(^BGPINDTC("AB",BGPO,BGPON,BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
...Q:$P($G(^BGPINDTC(BGPX,17)),U,1)="" ;not an icare item
...I $Y>(IOSL-3) D HEADER Q:BGPQUIT
...W !,BGPON,?10,$P(^BGPINDTC(BGPX,0),U,4),?21,$$VAL^XBDIQ1(90377.02,BGPX,1701),?42,$$VAL^XBDIQ1(90377.02,BGPX,1702)
...W ?63,$$VAL^XBDIQ1(90377.02,BGPX,1704)
...W ?70,$$VAL^XBDIQ1(90377.02,BGPX,1705),!
...I $Y>(IOSL-3) D HEADER Q:BGPQUIT
...W "iCare Report Code: ",$$VALI^XBDIQ1(90377.02,BGPX,1706)," ",$$VAL^XBDIQ1(90377.02,BGPX,1706),!
...I $Y>(IOSL-3) D HEADER Q:BGPQUIT
...W "iCare Name: ",$$VAL^XBDIQ1(90377.02,BGPX,1703),!
...I $Y>(IOSL-3) D HEADER Q:BGPQUIT
...W "iCare Tooltip: ",!
...S BGPY=0 F S BGPY=$O(^BGPINDTC(BGPX,18,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
....I $Y>(IOSL-3) D HEADER Q:BGPQUIT
....W ^BGPINDTC(BGPX,18,BGPY,0),!
W !
D EOP
Q
G:'BGPPAGE HEADER1
K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED),'$D(IO("S")) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQUIT=1 Q
S BGPPAGE=BGPPAGE+1
I BGPPAGE'=1 W:$D(IOF) @IOF
W $P(^VA(200,DUZ,0),U,2),?70,"Page ",BGPPAGE,!
W $$CTR("*** ICARE TEXT Report ***",80),!
S X="Date Report Run: "_$$FMTE^XLFDT(DT) W $$CTR(X,80),!
S X="Site where Run: "_$P(^DIC(4,DUZ(2),0),U) W $$CTR(X,80),!
S X="Report Generated by: "_$P(^VA(200,DUZ,0),U) W $$CTR(X,80),!
W $$CTR($$RPTVER^BGP0BAN,80),!
W "ORDER",?10,"MEAS ID",?21,"ICARE GROUP",?42,"ICARE CATEGORY",?63,"EXCEPT",?70,"PER DIR",!
S X=$$REPEAT^XLFSTR("-",80) W !,X
W !
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT["TRM")!$D(IO("S"))
NEW DIR
K DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
W ! S DIR("A")="End of report. Press ENTER to continue",DIR(0)="E" D ^DIR KILL DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
;
BGP0DICR ; IHS/CMI/LAB - ICARE LIST ;
+1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
+2 ;
+3 ;
+4 ;
START ;EP
+1 WRITE !,$$CTR("2010 ICARE DATA ITEMS",80)
+2 WRITE !,$$CTR($$RPTVER^BGP0BAN,80)
INTRO ;
+1 WRITE !!,"This report will list all individual measures that contain iCare data"
+2 WRITE !,"data elements.",!
+3 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
DO XIT
QUIT
+5 IF 'Y
DO XIT
QUIT
ZIS ;call to XBDBQUE
+1 KILL ZTSK
+2 KILL IOP,%ZIS
SET %ZIS="PQM"
DO ^%ZIS
IF POP
SET IO=IO(0)
QUIT
+3 IF $DATA(IO("Q"))
GOTO QUE
NOQUE ;
+1 USE IO
+2 DO PRINT
+3 DO ^%ZISC
+4 DO XIT
+5 QUIT
QUE ;
+1 KILL ZTSAVE
SET ZTSAVE("BGP*")=""
+2 SET ZTRTN="PRINT^BGP0DICR"
SET ZTDESC="BGP 10 ICARE TEXT REPORT"
SET ZTIO=ION
SET ZTDTH=""
+3 DO ^%ZTLOAD
+4 DO HOME^%ZIS
+5 DO XIT
+6 QUIT
XIT ;
+1 DO EN^XBVK("BGP")
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 DO ^XBFMK
+3 QUIT
+4 ;
PRINT ;
+1 SET (BGPPAGE,BGPQUIT)=0
+2 SET BGPIOSL=$SELECT($GET(BGPGUI):55,1:$GET(IOSL))
+3 DO HEADER
+4 SET BGPO=""
FOR
SET BGPO=$ORDER(^BGPINDTC("AB",BGPO))
IF BGPO=""!(BGPQUIT)
QUIT
Begin DoDot:1
+5 SET BGPON=""
FOR
SET BGPON=$ORDER(^BGPINDTC("AB",BGPO,BGPON))
IF BGPON=""!(BGPQUIT)
QUIT
Begin DoDot:2
+6 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDTC("AB",BGPO,BGPON,BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:3
+7 ;not an icare item
IF $PIECE($GET(^BGPINDTC(BGPX,17)),U,1)=""
QUIT
+8 IF $Y>(IOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+9 WRITE !,BGPON,?10,$PIECE(^BGPINDTC(BGPX,0),U,4),?21,$$VAL^XBDIQ1(90377.02,BGPX,1701),?42,$$VAL^XBDIQ1(90377.02,BGPX,1702)
+10 WRITE ?63,$$VAL^XBDIQ1(90377.02,BGPX,1704)
+11 WRITE ?70,$$VAL^XBDIQ1(90377.02,BGPX,1705),!
+12 IF $Y>(IOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+13 WRITE "iCare Report Code: ",$$VALI^XBDIQ1(90377.02,BGPX,1706)," ",$$VAL^XBDIQ1(90377.02,BGPX,1706),!
+14 IF $Y>(IOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+15 WRITE "iCare Name: ",$$VAL^XBDIQ1(90377.02,BGPX,1703),!
+16 IF $Y>(IOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+17 WRITE "iCare Tooltip: ",!
+18 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPINDTC(BGPX,18,BGPY))
IF BGPY'=+BGPY!(BGPQUIT)
QUIT
Begin DoDot:4
+19 IF $Y>(IOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+20 WRITE ^BGPINDTC(BGPX,18,BGPY,0),!
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 WRITE !
+22 DO EOP
+23 QUIT
+1 IF 'BGPPAGE
GOTO HEADER1
+2 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
IF '$DATA(IO("S"))
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BGPQUIT=1
QUIT
+1 SET BGPPAGE=BGPPAGE+1
+2 IF BGPPAGE'=1
IF $DATA(IOF)
WRITE @IOF
+3 WRITE $PIECE(^VA(200,DUZ,0),U,2),?70,"Page ",BGPPAGE,!
+4 WRITE $$CTR("*** ICARE TEXT Report ***",80),!
+5 SET X="Date Report Run: "_$$FMTE^XLFDT(DT)
WRITE $$CTR(X,80),!
+6 SET X="Site where Run: "_$PIECE(^DIC(4,DUZ(2),0),U)
WRITE $$CTR(X,80),!
+7 SET X="Report Generated by: "_$PIECE(^VA(200,DUZ,0),U)
WRITE $$CTR(X,80),!
+8 WRITE $$CTR($$RPTVER^BGP0BAN,80),!
+9 WRITE "ORDER",?10,"MEAS ID",?21,"ICARE GROUP",?42,"ICARE CATEGORY",?63,"EXCEPT",?70,"PER DIR",!
+10 SET X=$$REPEAT^XLFSTR("-",80)
WRITE !,X
+11 WRITE !
+12 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT["TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 WRITE !
SET DIR("A")="End of report. Press ENTER to continue"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
+3 ;
