BDMDMTX ; IHS/CMI/LAB - display audit logic ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
;
;
EP ;EP - CALLED FROM OPTION
;select year
S BDMYR=""
W:$D(IOF) @IOF
W !!,"Select the Audit Year",!!
S DIC="^BDMDMTX(",DIC(0)="AEMQ" D ^DIC K DIC I Y=-1 W !!,"Goodbye" G EOJ
S BDMYR=+Y
D EN
Q
EOJ ;EP
I '$D(BDMGUI) D EN^XBVK("BDM")
Q
;; ;
EN ; -- main entry point for BDM DM LOGIC DISPLAY
D EN^VALM("BDM DM LOGIC DISPLAY")
D CLEAR^VALM1
D FULL^VALM1
W:$D(IOF) @IOF
D EOJ
Q
;
HDR ; -- header code
S VALMHDR(1)="DM Logic Display"
Q
;
INIT ; -- init variables and list array
K BDMDISP,BDMSEL,BDMHIGH,BDMLIST,BDMCSEL
S BDMO=$S($O(^BDMDMTX(BDMYR,11,"AO",0)):"AO",1:"B")
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
S BDMCUT=((BDMHIGH/3)+1)\1
;S BDMCUT=(BDMHIGH/3)\1
S (C,I)=0,J=1,K=1 F S I=$O(BDMSEL(I)) Q:I'=+I!($D(BDMDISP(I))) D
.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)
.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)
.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)
K BDMDISP
S VALMCNT=C
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
BACK ;go back to listman
D TERM^VALM0
S VALMBCK="R"
D INIT
D HDR
K DIR
K X,Y,Z,I
Q
;
ADD ;EP - add an item to the selected list - called from a protocol
W ! S DIR(0)="LO^1:"_BDMHIGH,DIR("A")="Which item(s)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No items selected." G ADDX
I $D(DIRUT) W !,"No items selected." G ADDX
D FULL^VALM1 W:$D(IOF) @IOF
S BDMANS=Y,BDMC="" F BDMI=1:1 S BDMC=$P(BDMANS,",",BDMI) Q:BDMC="" S BDMCSEL(BDMC)=""
D DISPLAY
ADDX ;
D BACK
Q
ADDALL ;
F X=1:1:BDMHIGH S BDMCSEL(X)=""
D DISPLAY
D BACK
Q
;
DISPLAY ;gather in ^TMP and display
K ^TMP("BDMDMTX",$J)
S ^TMP("BDMDMTX",$J,0)=0
S BDMC=0
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
.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)
.Q
K ^TMP("BDMDMTX",$J,0)
D ARRAY^XBLM("^TMP(""BDMDMTX"",$J,","DM AUDIT LOGIC DESCRIPTIONS")
Q
S(Y,F,C,T) ;set up array
I '$G(F) S F=0
I '$G(T) S T=0
;blank lines
F F=1:1:F S X="" D S1
S X=Y
I $G(C) S L=$L(Y),T=(80-L)/2 D D S1 Q
.F %=1:1:(T-1) S X=" "_X
F %=1:1:T S X=" "_Y
D S1
Q
S1 ;
S %=$P(^TMP("BDMDMTX",$J,0),U)+1,$P(^TMP("BDMDMTX",$J,0),U)=%
S ^TMP("BDMDMTX",$J,%,0)=X
Q
BDMDMTX ; IHS/CMI/LAB - display audit logic ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
+2 ;
+3 ;
EP ;EP - CALLED FROM OPTION
+1 ;select year
+2 SET BDMYR=""
+3 IF $DATA(IOF)
WRITE @IOF
+4 WRITE !!,"Select the Audit Year",!!
+5 SET DIC="^BDMDMTX("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
IF Y=-1
WRITE !!,"Goodbye"
GOTO EOJ
+6 SET BDMYR=+Y
+7 DO EN
+8 QUIT
EOJ ;EP
+1 IF '$DATA(BDMGUI)
DO EN^XBVK("BDM")
+2 QUIT
+3 ;; ;
EN ; -- main entry point for BDM DM LOGIC DISPLAY
+1 DO EN^VALM("BDM DM LOGIC DISPLAY")
+2 DO CLEAR^VALM1
+3 DO FULL^VALM1
+4 IF $DATA(IOF)
WRITE @IOF
+5 DO EOJ
+6 QUIT
+7 ;
HDR ; -- header code
+1 SET VALMHDR(1)="DM Logic Display"
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 KILL BDMDISP,BDMSEL,BDMHIGH,BDMLIST,BDMCSEL
+2 SET BDMO=$SELECT($ORDER(^BDMDMTX(BDMYR,11,"AO",0)):"AO",1:"B")
+3 SET BDMHIGH=0
SET X=0
SET O=0
FOR
SET O=$ORDER(^BDMDMTX(BDMYR,11,BDMO,O))
IF O'=+O
QUIT
SET X=$ORDER(^BDMDMTX(BDMYR,11,BDMO,O,0))
SET BDMHIGH=BDMHIGH+1
SET BDMSEL(BDMHIGH)=X
+4 SET BDMCUT=((BDMHIGH/3)+1)\1
+5 ;S BDMCUT=(BDMHIGH/3)\1
+6 SET (C,I)=0
SET J=1
SET K=1
FOR
SET I=$ORDER(BDMSEL(I))
IF I'=+I!($DATA(BDMDISP(I)))
QUIT
Begin DoDot:1
+7 SET C=C+1
SET BDMLIST(C,0)=I_") "_$SELECT($DATA(BDMCSEL(I)):"*",1:" ")_$EXTRACT($PIECE(^BDMDMTX(BDMYR,11,BDMSEL(I),0),U),1,20)
SET BDMDISP(I)=""
SET BDMLIST("IDX",C,C)=BDMSEL(I)
+8 SET J=I+BDMCUT
IF $DATA(BDMSEL(J))
IF '$DATA(BDMDISP(J))
SET $EXTRACT(BDMLIST(C,0),28)=J_") "_$SELECT($DATA(BDMCSEL(J)):"*",1:" ")_$EXTRACT($PIECE(^BDMDMTX(BDMYR,11,BDMSEL(J),0),U),1,20)
SET BDMDISP(J)=""
SET BDMLIST("IDX",J,J)=BDMSEL(J)
+9 SET K=J+BDMCUT
IF $DATA(BDMSEL(K))
IF '$DATA(BDMDISP(K))
SET $EXTRACT(BDMLIST(C,0),55)=K_") "_$SELECT($DATA(BDMCSEL(K)):"*",1:" ")_$EXTRACT($PIECE(^BDMDMTX(BDMYR,11,BDMSEL(K),0),U),1,20)
SET BDMDISP(K)=""
SET BDMLIST("IDX",K,K)=BDMSEL(K)
End DoDot:1
+10 KILL BDMDISP
+11 SET VALMCNT=C
+12 QUIT
+13 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
BACK ;go back to listman
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 DO INIT
+4 DO HDR
+5 KILL DIR
+6 KILL X,Y,Z,I
+7 QUIT
+8 ;
ADD ;EP - add an item to the selected list - called from a protocol
+1 WRITE !
SET DIR(0)="LO^1:"_BDMHIGH
SET DIR("A")="Which item(s)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF Y=""
WRITE !,"No items selected."
GOTO ADDX
+3 IF $DATA(DIRUT)
WRITE !,"No items selected."
GOTO ADDX
+4 DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+5 SET BDMANS=Y
SET BDMC=""
FOR BDMI=1:1
SET BDMC=$PIECE(BDMANS,",",BDMI)
IF BDMC=""
QUIT
SET BDMCSEL(BDMC)=""
+6 DO DISPLAY
ADDX ;
+1 DO BACK
+2 QUIT
ADDALL ;
+1 FOR X=1:1:BDMHIGH
SET BDMCSEL(X)=""
+2 DO DISPLAY
+3 DO BACK
+4 QUIT
+5 ;
DISPLAY ;gather in ^TMP and display
+1 KILL ^TMP("BDMDMTX",$JOB)
+2 SET ^TMP("BDMDMTX",$JOB,0)=0
+3 SET BDMC=0
+4 SET BDMX=0
FOR
SET BDMX=$ORDER(BDMCSEL(BDMX))
IF BDMX'=+BDMX
QUIT
SET BDMY=BDMLIST("IDX",BDMX,BDMX)
SET Y=$PIECE(^BDMDMTX(BDMYR,11,BDMY,0),U)
SET BDMC=BDMC+1
DO S(Y,$SELECT(BDMC=1:0,1:2),1)
Begin DoDot:1
+5 SET Y=0
FOR
SET Y=$ORDER(^BDMDMTX(BDMYR,11,BDMY,11,Y))
IF Y'=+Y
QUIT
SET Z=^BDMDMTX(BDMYR,11,BDMY,11,Y,0)
DO S(Z)
+6 QUIT
End DoDot:1
+7 KILL ^TMP("BDMDMTX",$JOB,0)
+8 DO ARRAY^XBLM("^TMP(""BDMDMTX"",$J,","DM AUDIT LOGIC DESCRIPTIONS")
+9 QUIT
S(Y,F,C,T) ;set up array
+1 IF '$GET(F)
SET F=0
+2 IF '$GET(T)
SET T=0
+3 ;blank lines
+4 FOR F=1:1:F
SET X=""
DO S1
+5 SET X=Y
+6 IF $GET(C)
SET L=$LENGTH(Y)
SET T=(80-L)/2
Begin DoDot:1
+7 FOR %=1:1:(T-1)
SET X=" "_X
End DoDot:1
DO S1
QUIT
+8 FOR %=1:1:T
SET X=" "_Y
+9 DO S1
+10 QUIT
S1 ;
+1 SET %=$PIECE(^TMP("BDMDMTX",$JOB,0),U)+1
SET $PIECE(^TMP("BDMDMTX",$JOB,0),U)=%
+2 SET ^TMP("BDMDMTX",$JOB,%,0)=X
+3 QUIT
