- 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 ;