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

BDMDETV.m

Go to the documentation of this file. 
  1. BDMDETV ; IHS/CMI/LAB - DISPLAY IND LISTS ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**10**;JUN 14, 2007;Build 12
  1.  ;; ;
  1. EP ;EP - CALLED FROM OPTION
  1.  D EN
  1.  Q
  1. EOJ ;EP
  1.  I '$D(BDMGUI) D EN^XBVK("BDM")
  1.  Q
  1.  ;; ;
  1. EN ;EP -- main entry point for 
  1.  D EN^VALM("BDMDE TAXONOMY VIEW")
  1.  D CLEAR^VALM1
  1.  D FULL^VALM1
  1.  W:$D(IOF) @IOF
  1.  D EOJ
  1.  Q
  1.  ;
  1. PAUSE ;EP
  1.  Q:$E(IOST)'="C"!(IO'=IO(0))
  1.  W ! S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1. HDR ; -- header code
  1.  S VALMHDR(1)="TAXONOMIES TO SUPPORT 2017 DIABETES/PRE-DIABETES AUDIT REPORTING"
  1.  S VALMHDR(2)="* View Taxonomies"
  1.  Q
  1.  ;
  1. INIT ;EP -- init variables and list array
  1.  K BDMTAX S BDMHIGH="",C=0
  1.  S BDMYR=$O(^BDMTAXS("B",2017,0))
  1.  S BDMX=0,J=0 F  S BDMX=$O(^BDMTAXS(BDMYR,11,"B",BDMX)) Q:BDMX=""  D
  1.  .S BDMY=$O(^BDMTAXS(BDMYR,11,"B",BDMX,0))
  1.  .;Q:'$P(^BDMTAXS(BDMYR,11,BDMY,0),U,5)
  1.  .S Y=$P(^DIC($P(^BDMTAXS(BDMYR,11,BDMY,0),U,2),0),U)
  1.  .S J=J+1
  1.  .S BDMTAX(J,0)=J_")  "_BDMX,$E(BDMTAX(J,0),38)=$E(Y,1,30)
  1.  .I $P(^BDMTAXS(BDMYR,11,BDMY,0),U,2)'=60 S I=$O(^ATXAX("B",BDMX,0))
  1.  .I $P(^BDMTAXS(BDMYR,11,BDMY,0),U,2)=60 S I=$O(^ATXLAB("B",BDMX,0))
  1.  .S BDMTAX("IDX",J,J)=I_U_$S($P(^BDMTAXS(BDMYR,11,BDMY,0),U,2)=60:"L",1:"T")
  1.  .S C=C+1
  1.  .Q
  1.  S (VALMCNT,BDMHIGH)=C
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. BACK ;go back to listman
  1.  D TERM^VALM0
  1.  S VALMBCK="R"
  1.  D INIT
  1.  D HDR
  1.  K DIR
  1.  K X,Y,Z,I
  1.  Q
  1.  ;
  1. DISP ;EP - add an item to the selected list - called from a protocol
  1.  W !
  1.  S DIR(0)="NO^1:"_BDMHIGH,DIR("A")="Which Taxonomy"
  1.  D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !,"No taxonomy selected." G DISPX
  1.  I $D(DIRUT) W !,"No taxonomy selected." G DISPX
  1.  S BDMTAXI=$P(BDMTAX("IDX",Y,Y),U,1),BDMTAXT=$P(BDMTAX("IDX",Y,Y),U,2)
  1.  ;BROWSE OR PRINT
  1.  D FULL^VALM1
  1.  W ! S DIR(0)="S^P:PRINT Taxonomy Output;B:BROWSE Taxonomy Output on Screen",DIR("A")="Do you wish to",DIR("B")="B" K DA D ^DIR K DIR
  1.  I $D(DIRUT) D XIT Q
  1.  S BDMOPT=Y
  1.  I Y="B" D BROWSE,XIT Q
  1.  S XBRP="PRINT^BDMDETV",XBRC="",XBRX="XIT^BDMDETV",XBNS="BDM"
  1.  D ^XBDBQUE
  1.  D DISPX
  1.  Q
  1. BROWSE ;
  1.  S XBRP="VIEWR^XBLM(""PRINT^BDMDETV"")"
  1.  S XBRC="",XBRX="XIT^BDMDETV",XBIOP=0 D ^XBDBQUE
  1.  Q
  1. PHDR ;
  1.  I 'BDMPG G HEAD1
  1.  I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDMQ="" Q
  1. HEAD1 ;
  1.  I BDMPG W:$D(IOF) @IOF
  1.  S BDMPG=BDMPG+1
  1.  I $G(BDMGUI),BDMPG'=1 W !,"ZZZZZZZ"
  1.  W !,$P(^VA(200,DUZ,0),U,2),?72,"Page ",BDMPG,!
  1.  W ?(80-$L($P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U))/2),$P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U),!
  1.  W $$CTR("Listing of the "_BDMTAXN_" taxonomy",80),!,BDM80D,!
  1.  Q
  1. PRINT ;
  1.  S BDMPG=0
  1.  K BDMQ
  1.  I BDMTAXT="L" S BDMTAXN=$P(^ATXLAB(BDMTAXI,0),U,1)
  1.  I BDMTAXT="T" S BDMTAXN=$P(^ATXAX(BDMTAXI,0),U,1)
  1.  S BDM80D="-------------------------------------------------------------------------------"
  1.  D PHDR
  1.  I BDMTAXT'="L" S BDMFILE=$P(^ATXAX(BDMTAXI,0),U,15)
  1.  I BDMTAXT="L" S BDMFILE=60
  1. P1 K ^TMP($J,"BDMTAXDSP")
  1.  I BDMTAXT="L" D  G P11
  1.  .S X="" F  S X=$O(^ATXLAB(BDMTAXI,21,"B",X)) Q:X=""  D
  1.  ..S ^TMP($J,"BDMTAXDSP",X)=""
  1.  S F=$NA(^TMP($J,"BDMTAXDSP"))
  1.  I BDMFILE'=50.67,BDMFILE'=9999999.64,BDMFILE'=95.3,BDMFILE'=60,BDMFILE'=9999999.14 D BLDTAX^ATXAPI(BDMTAXN,F,$O(^ATXAX("B",BDMTAXN,0))) I 1
  1.  E  S BDMX="" F  S BDMX=$O(^ATXAX(BDMTAXI,21,"B",BDMX)) Q:BDMX=""  S ^TMP($J,"BDMTAXDSP",BDMX)=""
  1.  S BDMFILE=$P(^ATXAX(BDMTAXI,0),U,15)
  1. P11 S BDMX="" F  S BDMX=$O(^TMP($J,"BDMTAXDSP",BDMX)) Q:BDMX=""  D
  1.  .S (BDM1,BDM2,BDMF,BDM3,BDMC2,BDMC3)=""
  1.  .S BDMC2=35,BDMC3=65
  1.  .I BDMFILE=80 S D=$$ICDDX^ICDEX(BDMX,DT,,"I") S BDM1=$P(D,U,2),BDM2=$E($P(D,U,4),1,50),BDM3=$P(D,U,20),BDM3=$P(^ICDS(BDM3,0),U,1),BDMC2=15,BDMC3=65
  1.  .I BDMFILE=80.1 S D=$$ICDOP^ICDEX(BDMX,DT,,"I") S BDM1=$P(D,U,2),BDM2=$E($P(D,U,5),1,50),BDM3=$P(D,U,15),BDM3=$P(^ICDS(BDM3,0),U,1),BDMC2=15,BDMC3=65
  1.  .I BDMFILE=81 S D=$$CPT^ICPTCOD(BDMX) S BDM1=$P(D,U,2),BDM2=$P(D,U,3),BDMC2=15
  1.  .I BDMFILE=50.67 S BDM1=BDMX,BDM2=$O(^PSNDF(50.67,"NDC",$$STRIP^XLFSTR(BDM1,"-"),0)) I BDM2 S BDM2=$$GET1^DIQ(50.67,BDM2,4)
  1.  .I BDMFILE=9999999.64 S BDM1=$$GET1^DIQ(BDMFILE,BDMX,.01)
  1.  .I BDMFILE=9999999.09 S BDM1=$$GET1^DIQ(BDMFILE,BDMX,.01),BDM2=$$GET1^DIQ(BDMFILE,BDMX,1),BDMC2=50
  1.  .I BDMFILE=9999999.14 S BDM1=BDMX S %=$O(^AUTTIMM("C",BDMX,0)) I % S BDM2=$$GET1^DIQ(BDMFILE,%,.01),BDMC2=15
  1.  .I BDMFILE=95.3 S BDM1=BDMX S %=$O(^LAB(95.3,"B",$P(BDMX,"-"),0)) I % S BDM2=$$GET1^DIQ(95.3,%,80),BDMC2=15
  1.  .I BDM1="" D
  1.  ..S BDMF=".01"
  1.  ..S BDM1=$$GET1^DIQ(BDMFILE,BDMX,.01)
  1.  .I $Y>(IOSL-3) D PHDR Q:$D(BDMQ)
  1.  .W BDM1,?BDMC2,$E(BDM2,1,40),?BDMC3,BDM3,!
  1.  D XIT
  1.  Q
  1. DISPX ;
  1.  D BACK
  1.  Q
  1. XIT ;
  1.  K ^TMP($J,"BDMTAXDSP")
  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.  ;----------