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

BDMLLMR.m

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