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

BDMDMTX.m

Go to the documentation of this file. 
  1. BDMDMTX ; IHS/CMI/LAB - display audit logic ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
  1.  ;
  1.  ;
  1. EP ;EP - CALLED FROM OPTION
  1.  ;select year
  1.  S BDMYR=""
  1.  W:$D(IOF) @IOF
  1.  W !!,"Select the Audit Year",!!
  1.  S DIC="^BDMDMTX(",DIC(0)="AEMQ" D ^DIC K DIC I Y=-1 W !!,"Goodbye" G EOJ
  1.  S BDMYR=+Y
  1.  D EN
  1.  Q
  1. EOJ ;EP
  1.  I '$D(BDMGUI) D EN^XBVK("BDM")
  1.  Q
  1.  ;; ;
  1. EN ; -- main entry point for BDM DM LOGIC DISPLAY
  1.  D EN^VALM("BDM DM LOGIC DISPLAY")
  1.  D CLEAR^VALM1
  1.  D FULL^VALM1
  1.  W:$D(IOF) @IOF
  1.  D EOJ
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  S VALMHDR(1)="DM Logic Display"
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  K BDMDISP,BDMSEL,BDMHIGH,BDMLIST,BDMCSEL
  1.  S BDMO=$S($O(^BDMDMTX(BDMYR,11,"AO",0)):"AO",1:"B")
  1.  S BDMHIGH=0,X=0,O=0 F  S O=$O(^BDMDMTX(BDMYR,11,BDMO,O)) Q:O'=+O  S X=$O(^BDMDMTX(BDMYR,11,BDMO,O,0)) S BDMHIGH=BDMHIGH+1,BDMSEL(BDMHIGH)=X
  1.  S BDMCUT=((BDMHIGH/3)+1)\1
  1.  ;S BDMCUT=(BDMHIGH/3)\1
  1.  S (C,I)=0,J=1,K=1 F  S I=$O(BDMSEL(I)) Q:I'=+I!($D(BDMDISP(I)))  D
  1.  .S C=C+1,BDMLIST(C,0)=I_") "_$S($D(BDMCSEL(I)):"*",1:" ")_$E($P(^BDMDMTX(BDMYR,11,BDMSEL(I),0),U),1,20) S BDMDISP(I)="",BDMLIST("IDX",C,C)=BDMSEL(I)
  1.  .S J=I+BDMCUT I $D(BDMSEL(J)),'$D(BDMDISP(J)) S $E(BDMLIST(C,0),28)=J_") "_$S($D(BDMCSEL(J)):"*",1:" ")_$E($P(^BDMDMTX(BDMYR,11,BDMSEL(J),0),U),1,20) S BDMDISP(J)="",BDMLIST("IDX",J,J)=BDMSEL(J)
  1.  .S K=J+BDMCUT I $D(BDMSEL(K)),'$D(BDMDISP(K)) S $E(BDMLIST(C,0),55)=K_") "_$S($D(BDMCSEL(K)):"*",1:" ")_$E($P(^BDMDMTX(BDMYR,11,BDMSEL(K),0),U),1,20) S BDMDISP(K)="",BDMLIST("IDX",K,K)=BDMSEL(K)
  1.  K BDMDISP
  1.  S VALMCNT=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. ADD ;EP - add an item to the selected list - called from a protocol
  1.  W ! S DIR(0)="LO^1:"_BDMHIGH,DIR("A")="Which item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I Y="" W !,"No items selected." G ADDX
  1.  I $D(DIRUT) W !,"No items selected." G ADDX
  1.  D FULL^VALM1 W:$D(IOF) @IOF
  1.  S BDMANS=Y,BDMC="" F BDMI=1:1 S BDMC=$P(BDMANS,",",BDMI) Q:BDMC=""  S BDMCSEL(BDMC)=""
  1.  D DISPLAY
  1. ADDX ;
  1.  D BACK
  1.  Q
  1. ADDALL ;
  1.  F X=1:1:BDMHIGH S BDMCSEL(X)=""
  1.  D DISPLAY
  1.  D BACK
  1.  Q
  1.  ;
  1. DISPLAY ;gather in ^TMP and display
  1.  K ^TMP("BDMDMTX",$J)
  1.  S ^TMP("BDMDMTX",$J,0)=0
  1.  S BDMC=0
  1.  S BDMX=0 F  S BDMX=$O(BDMCSEL(BDMX)) Q:BDMX'=+BDMX  S BDMY=BDMLIST("IDX",BDMX,BDMX),Y=$P(^BDMDMTX(BDMYR,11,BDMY,0),U) S BDMC=BDMC+1 D S(Y,$S(BDMC=1:0,1:2),1) D
  1.  .S Y=0 F  S Y=$O(^BDMDMTX(BDMYR,11,BDMY,11,Y)) Q:Y'=+Y  S Z=^BDMDMTX(BDMYR,11,BDMY,11,Y,0) D S(Z)
  1.  .Q
  1.  K ^TMP("BDMDMTX",$J,0)
  1.  D ARRAY^XBLM("^TMP(""BDMDMTX"",$J,","DM AUDIT LOGIC DESCRIPTIONS")
  1.  Q
  1. S(Y,F,C,T) ;set up array
  1.  I '$G(F) S F=0
  1.  I '$G(T) S T=0
  1.  ;blank lines
  1.  F F=1:1:F S X="" D S1
  1.  S X=Y
  1.  I $G(C) S L=$L(Y),T=(80-L)/2 D  D S1 Q
  1.  .F %=1:1:(T-1) S X=" "_X
  1.  F %=1:1:T S X=" "_Y
  1.  D S1
  1.  Q
  1. S1 ;
  1.  S %=$P(^TMP("BDMDMTX",$J,0),U)+1,$P(^TMP("BDMDMTX",$J,0),U)=%
  1.  S ^TMP("BDMDMTX",$J,%,0)=X
  1.  Q