BDMLLMR ; IHS/CMI/LAB - PCC HEALTH SUMMARY ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**4,6,7,8,10**;JUN 14, 2007;Build 12
;
W:$D(IOF) @IOF
W !!,"This report will list all lab tests or medications that are used at"
W !,$P(^DIC(4,DUZ(2),0),U),". It will list the name, internal entry number,"
W !,"number of occurences, units and result example (lab only) and the taxonomies"
W !,"that the item is a member of.",!
TYPE ;
S BDMTYPE=""
S DIR(0)="S^L:LAB TESTS;M:MEDICATIONS (DRUGS)",DIR("A")="Do you wish to list" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
I Y="" D EXIT Q
S BDMTYPE=Y
S BDMTYPEP=Y(0)
;
GETDATES ;
BD ;get beginning date
W ! K DIR S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Date for Search",DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-365)) D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) D EXIT Q
S BDMBD=Y
ED ;get ending date
W ! S DIR(0)="DA^"_BDMBD_":DT:EP",DIR("A")="Enter ending date for Search: " S Y=BDMBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S BDMED=Y
S X1=BDMBD,X2=-1 D C^%DTC S BDMSD=X
;
;
ZIS ;EP
W !! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) D EXIT Q
S BDMOPT=Y
I Y="B" D BROWSE,EXIT Q
S XBRP="PRINT^BDMLLMR",XBRC="EN^BDMLLMR",XBRX="EXIT^BDMLLMR",XBNS="BDM;DFN"
D ^XBDBQUE
D EXIT1
Q
;
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BDMLLMR"")"
S XBRC="EN^BDMLLMR",XBRX="EXIT^BDMLLMR",XBIOP=0 D ^XBDBQUE
Q
EXIT ;
;K ^XTMP("BDMLLMR",BDMJ,BDMH)
D EN^XBVK("BDM")
K DFN
D ^XBFMK
Q
;
EXIT1 ;
D CLEAR^VALM1
D FULL^VALM1
D EN^XBVK("BDM")
K DFN
D ^XBFMK
Q
;
PRINT ;
S BDMPG=0
K BDMQUIT
I '$D(^XTMP("BDMLLMR",BDMJ,BDMH)) D HDR W !!,"Nothing to Report." Q
D HDR
S BDMNAME="" F S BDMNAME=$O(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",BDMNAME)) Q:BDMNAME=""!($D(BDMQUIT)) D
.I $Y>(IOSL-3) D HDR Q:$D(BDMQUIT)
.S BDMIEN=0 F S BDMIEN=$O(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",BDMNAME,BDMIEN)) Q:BDMIEN'=+BDMIEN!($D(BDMQUIT)) D
..S BDMD=^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",BDMNAME,BDMIEN)
..W $E(BDMNAME,1,30),?32,BDMIEN,?41,$$C($P(BDMD,U,1),0,9)
..I BDMTYPE="L" W ?51,$P(BDMD,U,3),?63,$P(BDMD,U,2)
..W ! S T=$$TAX(BDMIEN,BDMTYPE) I T]"" W ?5,T,!
..Q
.Q
I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report. PRESS ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
TAX(I,TYPE) ;
NEW X,Y,Z,N,G,A,B
S G=""
I TYPE="M" Q $$TAXM(I)
S Y=0 F S Y=$O(^BDMTAXS("B",Y)) Q:Y="" S Z=Y
S Y=$O(^BDMTAXS("B",Z,0))
S X=0 F S X=$O(^ATXLAB(X)) Q:X'=+X D
.S N=$P(^ATXLAB(X,0),U)
.Q:'$D(^BDMTAXS(Y,11,"B",N)) ;not used by dms
.Q:'$D(^ATXLAB(X,21,"B",I)) ;not in this taxonomy
.S G=$S(G]"":G_"; "_N,1:N)
.Q
Q G
TAXM(I) ;
NEW X,Y,Z,N,G,A,B
S G=""
S Y=0 F S Y=$O(^BDMTAXS("B",Y)) Q:Y="" S Z=Y
S Y=$O(^BDMTAXS("B",Z,0))
S X=0 F S X=$O(^ATXAX(X)) Q:X'=+X D
.Q:$P(^ATXAX(X,0),U,15)'=50
.S N=$P(^ATXAX(X,0),U)
.Q:'$D(^BDMTAXS(Y,11,"B",N)) ;not used by dms
.Q:'$D(^ATXAX(X,21,"B",I)) ;not in this taxonomy
.S G=$S(G]"":G_"; "_N,1:N)
.Q
Q G
C(X,X2,X3) ;
D COMMA^%DTC
Q X
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
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")
;----------
;
EN ;
S BDMJ=$J,BDMH=$H
K ^XTMP("BDMLLMR",BDMJ,BDMH)
S ^XTMP("BDMLLMR",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BDM LAB/MED REPORT"
NEW X,Y,BDMN,L,P,T
D PROC
Q
PROC ;
S BDMODAT=BDMSD_".9999" F S BDMODAT=$O(^AUPNVSIT("B",BDMODAT)) Q:BDMODAT=""!((BDMODAT\1)>BDMED) D V1
Q
V1 ;
S BDMVIEN="" F S BDMVIEN=$O(^AUPNVSIT("B",BDMODAT,BDMVIEN)) Q:BDMVIEN'=+BDMVIEN D
.Q:'$D(^AUPNVSIT(BDMVIEN,0))
.Q:'$P(^AUPNVSIT(BDMVIEN,0),U,9)
.Q:$P(^AUPNVSIT(BDMVIEN,0),U,11)
.D @BDMTYPE
Q
L ;
Q:'$D(^AUPNVLAB("AD",BDMVIEN))
S X=0 F S X=$O(^AUPNVLAB("AD",BDMVIEN,X)) Q:X'=+X D
.Q:'$D(^AUPNVLAB(X,0))
.S I=$P(^AUPNVLAB(X,0),U)
.S N=$$VAL^XBDIQ1(9000010.09,X,.01)
.S R=$P(^AUPNVLAB(X,0),U,4)
.S Y=$P($G(^AUPNVLAB(X,11)),U,1)
.I '$D(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I)) S ^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I)=0
.S $P(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I),U,1)=$P(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I),U,1)+1
.S $P(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I),U,2)=R
.S $P(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I),U,3)=Y
Q
M ;
Q:'$D(^AUPNVMED("AD",BDMVIEN))
S X=0 F S X=$O(^AUPNVMED("AD",BDMVIEN,X)) Q:X'=+X D
.Q:'$D(^AUPNVMED(X,0))
.S I=$P(^AUPNVMED(X,0),U)
.S N=$$VAL^XBDIQ1(9000010.14,X,.01)
.I '$D(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I)) S ^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I)=0
.S $P(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I),U,1)=$P(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I),U,1)+1
Q
HDR ;
G:BDMPG=0 HDR1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDMQUIT="" Q
HDR1 ;
I BDMPG W:$D(IOF) @IOF
S BDMPG=BDMPG+1
W $$FMTE^XLFDT(DT),?72,"Page ",BDMPG,!
W $$CTR(BDMTYPEP_" Used at "_$P(^DIC(4,DUZ(2),0),U),80),!
W $$CTR("Date Range: "_$$FMTE^XLFDT(BDMBD)_" - "_$$FMTE^XLFDT(BDMED)),!
W $S(BDMTYPE="L":"LAB TEST NAME",1:"MEDICATION/DRUG NAME"),?32,"IEN",?41,"# DONE"
I BDMTYPE="L" W ?51,"UNITS",?64,"RESULT"
W !,?5,"TAXONOMIES",!
W "--------------------------------------------------------------------",!
Q
;
BDMG(BDMJ,BDMBTH,BDMTYPE,BDMBD,BDMED) ;-- EP for LMR report
I BDMTYPE="L" S BDMTYPEP="LAB TESTS"
I BDMTYPE="M" S BDMTYPEP="MEDICATIONS (DRUGS)"
S X1=BDMBD,X2=-1 D C^%DTC S BDMSD=X
N BDMOPT ;maw
S BDMOPT="Lab/Medication Report"
D NOW^%DTC
S BDMNOW=$G(%)
K DD,D0,DIC
S X=DUZ_"."_BDMBTH
S DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.05////1;.06///"_$G(BDMOPT)_";.07////R"
S DIC="^BDMGUI(",DIC(0)="L",DIADD=1,DLAYGO=9003201.4
D FILE^DICN
K DIADD,DLAYGO,DIC,DA
I Y=-1 S BDMIEN=-1 Q
S BDMIEN=+Y
S BDMGIEN=BDMIEN
D ^XBFMK
K ZTSAVE S ZTSAVE("*")=""
S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^BDMLLMR",ZTDESC="LAB/MED REPORT" D ^%ZTLOAD
Q
;
GUIEP ;-- lets do the GUI report
D EN
K ^TMP($J,"BDMLAB")
S IOM=80 ;cmi/maw added
D GUIR^XBLM("PRINT^BDMLLMR","^TMP($J,""BDMLAB"",")
Q:$G(BDMDSP) ;quit if to screen
S X=0,C=0 F S X=$O(^TMP($J,"BDMLAB",X)) Q:X'=+X D
.S BDMDCTA=^TMP($J,"BDMLAB",X)
.;I BDMDCTA="ZZZZZZZ" S BDMDCTA=$C(12)
.S ^BDMGUI(BDMGIEN,11,X,0)=BDMDCTA,C=C+1
S ^BDMGUI(BDMGIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
S DA=BDMGIEN,DIK="^BDMGUI(" D IX1^DIK
D ENDLOG
K ^TMP($J,"BDMLAB")
S ZTREQ="@"
Q
;
ENDLOG ;-- write the end of the log
D NOW^%DTC
S BDMNOW=$G(%)
S DIE="^BDMGUI(",DA=BDMGIEN,DR=".04////"_BDMNOW_";.07////C"
D ^DIE
K DIE,DR,DA
Q
;
BDMLLMR ; IHS/CMI/LAB - PCC HEALTH SUMMARY ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**4,6,7,8,10**;JUN 14, 2007;Build 12
+2 ;
+3 IF $DATA(IOF)
WRITE @IOF
+4 WRITE !!,"This report will list all lab tests or medications that are used at"
+5 WRITE !,$PIECE(^DIC(4,DUZ(2),0),U),". It will list the name, internal entry number,"
+6 WRITE !,"number of occurences, units and result example (lab only) and the taxonomies"
+7 WRITE !,"that the item is a member of.",!
TYPE ;
+1 SET BDMTYPE=""
+2 SET DIR(0)="S^L:LAB TESTS;M:MEDICATIONS (DRUGS)"
SET DIR("A")="Do you wish to list"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO EXIT
QUIT
+4 IF Y=""
DO EXIT
QUIT
+5 SET BDMTYPE=Y
+6 SET BDMTYPEP=Y(0)
+7 ;
GETDATES ;
BD ;get beginning date
+1 WRITE !
KILL DIR
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Date for Search"
SET DIR("B")=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-365))
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
DO EXIT
QUIT
+3 SET BDMBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="DA^"_BDMBD_":DT:EP"
SET DIR("A")="Enter ending date for Search: "
SET Y=BDMBD
DO DD^%DT
SET Y=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET BDMED=Y
+4 SET X1=BDMBD
SET X2=-1
DO C^%DTC
SET BDMSD=X
+5 ;
+6 ;
ZIS ;EP
+1 WRITE !!
SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
DO EXIT
QUIT
+3 SET BDMOPT=Y
+4 IF Y="B"
DO BROWSE
DO EXIT
QUIT
+5 SET XBRP="PRINT^BDMLLMR"
SET XBRC="EN^BDMLLMR"
SET XBRX="EXIT^BDMLLMR"
SET XBNS="BDM;DFN"
+6 DO ^XBDBQUE
+7 DO EXIT1
+8 QUIT
+9 ;
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^BDMLLMR"")"
+2 SET XBRC="EN^BDMLLMR"
SET XBRX="EXIT^BDMLLMR"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
EXIT ;
+1 ;K ^XTMP("BDMLLMR",BDMJ,BDMH)
+2 DO EN^XBVK("BDM")
+3 KILL DFN
+4 DO ^XBFMK
+5 QUIT
+6 ;
EXIT1 ;
+1 DO CLEAR^VALM1
+2 DO FULL^VALM1
+3 DO EN^XBVK("BDM")
+4 KILL DFN
+5 DO ^XBFMK
+6 QUIT
+7 ;
PRINT ;
+1 SET BDMPG=0
+2 KILL BDMQUIT
+3 IF '$DATA(^XTMP("BDMLLMR",BDMJ,BDMH))
DO HDR
WRITE !!,"Nothing to Report."
QUIT
+4 DO HDR
+5 SET BDMNAME=""
FOR
SET BDMNAME=$ORDER(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",BDMNAME))
IF BDMNAME=""!($DATA(BDMQUIT))
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-3)
DO HDR
IF $DATA(BDMQUIT)
QUIT
+7 SET BDMIEN=0
FOR
SET BDMIEN=$ORDER(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",BDMNAME,BDMIEN))
IF BDMIEN'=+BDMIEN!($DATA(BDMQUIT))
QUIT
Begin DoDot:2
+8 SET BDMD=^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",BDMNAME,BDMIEN)
+9 WRITE $EXTRACT(BDMNAME,1,30),?32,BDMIEN,?41,$$C($PIECE(BDMD,U,1),0,9)
+10 IF BDMTYPE="L"
WRITE ?51,$PIECE(BDMD,U,3),?63,$PIECE(BDMD,U,2)
+11 WRITE !
SET T=$$TAX(BDMIEN,BDMTYPE)
IF T]""
WRITE ?5,T,!
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. PRESS ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+15 QUIT
TAX(I,TYPE) ;
+1 NEW X,Y,Z,N,G,A,B
+2 SET G=""
+3 IF TYPE="M"
QUIT $$TAXM(I)
+4 SET Y=0
FOR
SET Y=$ORDER(^BDMTAXS("B",Y))
IF Y=""
QUIT
SET Z=Y
+5 SET Y=$ORDER(^BDMTAXS("B",Z,0))
+6 SET X=0
FOR
SET X=$ORDER(^ATXLAB(X))
IF X'=+X
QUIT
Begin DoDot:1
+7 SET N=$PIECE(^ATXLAB(X,0),U)
+8 ;not used by dms
IF '$DATA(^BDMTAXS(Y,11,"B",N))
QUIT
+9 ;not in this taxonomy
IF '$DATA(^ATXLAB(X,21,"B",I))
QUIT
+10 SET G=$SELECT(G]"":G_"; "_N,1:N)
+11 QUIT
End DoDot:1
+12 QUIT G
TAXM(I) ;
+1 NEW X,Y,Z,N,G,A,B
+2 SET G=""
+3 SET Y=0
FOR
SET Y=$ORDER(^BDMTAXS("B",Y))
IF Y=""
QUIT
SET Z=Y
+4 SET Y=$ORDER(^BDMTAXS("B",Z,0))
+5 SET X=0
FOR
SET X=$ORDER(^ATXAX(X))
IF X'=+X
QUIT
Begin DoDot:1
+6 IF $PIECE(^ATXAX(X,0),U,15)'=50
QUIT
+7 SET N=$PIECE(^ATXAX(X,0),U)
+8 ;not used by dms
IF '$DATA(^BDMTAXS(Y,11,"B",N))
QUIT
+9 ;not in this taxonomy
IF '$DATA(^ATXAX(X,21,"B",I))
QUIT
+10 SET G=$SELECT(G]"":G_"; "_N,1:N)
+11 QUIT
End DoDot:1
+12 QUIT G
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
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 ;----------
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 ;
EN ;
+1 SET BDMJ=$JOB
SET BDMH=$HOROLOG
+2 KILL ^XTMP("BDMLLMR",BDMJ,BDMH)
+3 SET ^XTMP("BDMLLMR",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^BDM LAB/MED REPORT"
+4 NEW X,Y,BDMN,L,P,T
+5 DO PROC
+6 QUIT
PROC ;
+1 SET BDMODAT=BDMSD_".9999"
FOR
SET BDMODAT=$ORDER(^AUPNVSIT("B",BDMODAT))
IF BDMODAT=""!((BDMODAT\1)>BDMED)
QUIT
DO V1
+2 QUIT
V1 ;
+1 SET BDMVIEN=""
FOR
SET BDMVIEN=$ORDER(^AUPNVSIT("B",BDMODAT,BDMVIEN))
IF BDMVIEN'=+BDMVIEN
QUIT
Begin DoDot:1
+2 IF '$DATA(^AUPNVSIT(BDMVIEN,0))
QUIT
+3 IF '$PIECE(^AUPNVSIT(BDMVIEN,0),U,9)
QUIT
+4 IF $PIECE(^AUPNVSIT(BDMVIEN,0),U,11)
QUIT
+5 DO @BDMTYPE
End DoDot:1
+6 QUIT
L ;
+1 IF '$DATA(^AUPNVLAB("AD",BDMVIEN))
QUIT
+2 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AD",BDMVIEN,X))
IF X'=+X
QUIT
Begin DoDot:1
+3 IF '$DATA(^AUPNVLAB(X,0))
QUIT
+4 SET I=$PIECE(^AUPNVLAB(X,0),U)
+5 SET N=$$VAL^XBDIQ1(9000010.09,X,.01)
+6 SET R=$PIECE(^AUPNVLAB(X,0),U,4)
+7 SET Y=$PIECE($GET(^AUPNVLAB(X,11)),U,1)
+8 IF '$DATA(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I))
SET ^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I)=0
+9 SET $PIECE(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I),U,1)=$PIECE(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I),U,1)+1
+10 SET $PIECE(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I),U,2)=R
+11 SET $PIECE(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I),U,3)=Y
End DoDot:1
+12 QUIT
M ;
+1 IF '$DATA(^AUPNVMED("AD",BDMVIEN))
QUIT
+2 SET X=0
FOR
SET X=$ORDER(^AUPNVMED("AD",BDMVIEN,X))
IF X'=+X
QUIT
Begin DoDot:1
+3 IF '$DATA(^AUPNVMED(X,0))
QUIT
+4 SET I=$PIECE(^AUPNVMED(X,0),U)
+5 SET N=$$VAL^XBDIQ1(9000010.14,X,.01)
+6 IF '$DATA(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I))
SET ^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I)=0
+7 SET $PIECE(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I),U,1)=$PIECE(^XTMP("BDMLLMR",BDMJ,BDMH,"TESTS",N,I),U,1)+1
End DoDot:1
+8 QUIT
HDR ;
+1 IF BDMPG=0
GOTO HDR1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BDMQUIT=""
QUIT
HDR1 ;
+1 IF BDMPG
IF $DATA(IOF)
WRITE @IOF
+2 SET BDMPG=BDMPG+1
+3 WRITE $$FMTE^XLFDT(DT),?72,"Page ",BDMPG,!
+4 WRITE $$CTR(BDMTYPEP_" Used at "_$PIECE(^DIC(4,DUZ(2),0),U),80),!
+5 WRITE $$CTR("Date Range: "_$$FMTE^XLFDT(BDMBD)_" - "_$$FMTE^XLFDT(BDMED)),!
+6 WRITE $SELECT(BDMTYPE="L":"LAB TEST NAME",1:"MEDICATION/DRUG NAME"),?32,"IEN",?41,"# DONE"
+7 IF BDMTYPE="L"
WRITE ?51,"UNITS",?64,"RESULT"
+8 WRITE !,?5,"TAXONOMIES",!
+9 WRITE "--------------------------------------------------------------------",!
+10 QUIT
+11 ;
BDMG(BDMJ,BDMBTH,BDMTYPE,BDMBD,BDMED) ;-- EP for LMR report
+1 IF BDMTYPE="L"
SET BDMTYPEP="LAB TESTS"
+2 IF BDMTYPE="M"
SET BDMTYPEP="MEDICATIONS (DRUGS)"
+3 SET X1=BDMBD
SET X2=-1
DO C^%DTC
SET BDMSD=X
+4 ;maw
NEW BDMOPT
+5 SET BDMOPT="Lab/Medication Report"
+6 DO NOW^%DTC
+7 SET BDMNOW=$GET(%)
+8 KILL DD,D0,DIC
+9 SET X=DUZ_"."_BDMBTH
+10 SET DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.05////1;.06///"_$GET(BDMOPT)_";.07////R"
+11 SET DIC="^BDMGUI("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9003201.4
+12 DO FILE^DICN
+13 KILL DIADD,DLAYGO,DIC,DA
+14 IF Y=-1
SET BDMIEN=-1
QUIT
+15 SET BDMIEN=+Y
+16 SET BDMGIEN=BDMIEN
+17 DO ^XBFMK
+18 KILL ZTSAVE
SET ZTSAVE("*")=""
+19 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
SET ZTRTN="GUIEP^BDMLLMR"
SET ZTDESC="LAB/MED REPORT"
DO ^%ZTLOAD
+20 QUIT
+21 ;
GUIEP ;-- lets do the GUI report
+1 DO EN
+2 KILL ^TMP($JOB,"BDMLAB")
+3 ;cmi/maw added
SET IOM=80
+4 DO GUIR^XBLM("PRINT^BDMLLMR","^TMP($J,""BDMLAB"",")
+5 ;quit if to screen
IF $GET(BDMDSP)
QUIT
+6 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"BDMLAB",X))
IF X'=+X
QUIT
Begin DoDot:1
+7 SET BDMDCTA=^TMP($JOB,"BDMLAB",X)
+8 ;I BDMDCTA="ZZZZZZZ" S BDMDCTA=$C(12)
+9 SET ^BDMGUI(BDMGIEN,11,X,0)=BDMDCTA
SET C=C+1
End DoDot:1
+10 SET ^BDMGUI(BDMGIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
+11 SET DA=BDMGIEN
SET DIK="^BDMGUI("
DO IX1^DIK
+12 DO ENDLOG
+13 KILL ^TMP($JOB,"BDMLAB")
+14 SET ZTREQ="@"
+15 QUIT
+16 ;
ENDLOG ;-- write the end of the log
+1 DO NOW^%DTC
+2 SET BDMNOW=$GET(%)
+3 SET DIE="^BDMGUI("
SET DA=BDMGIEN
SET DR=".04////"_BDMNOW_";.07////C"
+4 DO ^DIE
+5 KILL DIE,DR,DA
+6 QUIT
+7 ;
