Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP0DICR

BGP0DICR.m

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