DICE7 ;SFISC/GFT-BULLETIN X-REFS ;12:38 PM 8 Jun 1995
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
K ^UTILITY("DICE",$J) S ^($J,0)="^^BULLETIN MESSAGE",DOLD=$P(^DD(DI,DL,0),U,1)
F DIK=1,2 Q:$D(DTOUT) D M G QQ:X[U!$D(DTOUT) I X]"" S DQI="Y(",DCOND="SENDING OF '"_DREF_"'" D DA,CC^DICE4,DA G QQ:$D(DTOUT) S DHI=0,DLAY=$S($D(DCOND):X,1:"") D S G QQ:X=U
Q:$D(DTOUT) G X^DICE0
QQ G QQ^DICE
;
DA S DA="^DD("_DI_","_DL_",1,"_DQ_"," Q
;
M W !!!,"---"_$P("SET^KILL",U,DIK)_" LOGIC---",!!,"ENTER THE NAME OF A 'BULLETIN' MESSAGE, IF YOU WANT THAT MESSAGE SENT"
D GET^DICE2 Q:U[X S DIC=3.6,DIC(0)="ELMQ",DIC("DR")=".01;2;4;11;10" D ^DIC K DIC,DICOMPX G M:Y<0
S (DREF,^UTILITY("DICE",$J,$P("CREA^DELE",U,DIK)_"TE VALUE"))=$P(Y,U,2),DCOND=DI_U_DL_U_DIK_U_DQ
S DIE=3.6,DA=+Y,DR=10 D:'$P(Y,U,3) ^DIE S X=DREF,DI=$P(DCOND,U,1),DL=$P(DCOND,U,2),DIK=$P(DCOND,U,3),DQ=$P(DCOND,U,4) Q
;
S W " ..OK",! S DHI=DHI+1
SS S DLOC="PARAMETER #"_DHI I DHI>1 W !,"NOW, IF THE BULLETIN IS TO HAVE "_DHI_" OR MORE PARAMETERS INSERTED,"
W !,"ENTER A FIELD NAME (FOR EXAMPLE, '"_DOLD_"'),",!,"OR A 'COMPUTED-FIELD' EXPRESSION,",!,"THE VALUE OF WHICH WILL BE PASSED INTO THE '"_DREF_"' MESSAGE,",!,"AS "_DLOC
S X=$O(^XMB(3.6,"B",DREF,0)) S:X="" X=-1 I X F Y=1:1 Q:'$D(^XMB(3.6,X,4,Y,0)) I ^(0)=DHI F D=1:1 G T:'$D(^XMB(3.6,X,4,Y,1,D,0)) W !?4,"-- ",^(0)
W !,"(NOTE THAT NO SUCH PARAMETER IS DEFINED FOR THE '"_DREF_"' BULLETIN)"
T W ! D OLD^DICE2 W DLOC_": " R X:DTIME S:'$T DTOUT=1 G:X?.P QQ:X=U!'$T,SET:X="",SS S DSUB=X,DICOMP="?" D ^DICOMP I $D(X)-1 W $C(7),"??",! G SS
S DHI(DHI)=X_$P(" S Y=X X ^DD(""DD"") S X=Y",1,Y["D"),^UTILITY("DICE",$J,$P("CREA^DELE",U,DIK)_"TE "_DLOC)=DSUB G S
SET W !
S ^UTILITY("DICE",$J,DIK)="K XMY S XMB="""_DREF_""" D ^XMB:$D(^XMB(3.6,""B"",XMB)) K Y,XMB"
;
F D=1:1 Q:'$D(DHI(D)) D
. S X="S X=Y(0) "_DHI(D)_" S XMB("_D_")=X"
. S %=DIK_"."_$E("00",1,3-$L(D))_D
. S ^UTILITY("DICE",$J,+%)=X
;
S Y=""
S:$D(DHI(1))#2 Y=" X ""N DIIND F DIIND="_DIK_".001:.001 Q:$D("_DA_"DIIND))[0 X ^(DIIND)"""
S I="S Y(0)=X,D"_N_"=DA" F %=1:1:N S I=I_",D"_(N-%)_"=DA("_%_")"
;
I $L(DLAY) D
. S Y=" I X"_Y
. S:$L(I)+$L(Y)+$L(DLAY)+$L(^(DIK))>238 ^(DIK+.9)=DLAY,DLAY="X "_DA_(DIK+.9)_")"
. S DLAY=" "_DLAY
;
S:Y]""!$L(DLAY) ^(DIK)=I_DLAY_Y_" "_^(DIK)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICE7 2567 printed Oct 16, 2024@18:46:31 Page 2
DICE7 ;SFISC/GFT-BULLETIN X-REFS ;12:38 PM 8 Jun 1995
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 KILL ^UTILITY("DICE",$JOB)
SET ^($JOB,0)="^^BULLETIN MESSAGE"
SET DOLD=$PIECE(^DD(DI,DL,0),U,1)
+8 FOR DIK=1,2
if $DATA(DTOUT)
QUIT
DO M
if X[U!$DATA(DTOUT)
GOTO QQ
IF X]""
SET DQI="Y("
SET DCOND="SENDING OF '"_DREF_"'"
DO DA
DO CC^DICE4
DO DA
if $DATA(DTOUT)
GOTO QQ
SET DHI=0
SET DLAY=$SELECT($DATA(DCOND):X,1:"")
DO S
if X=U
GOTO QQ
+9 if $DATA(DTOUT)
QUIT
GOTO X^DICE0
QQ GOTO QQ^DICE
+1 ;
DA SET DA="^DD("_DI_","_DL_",1,"_DQ_","
QUIT
+1 ;
M WRITE !!!,"---"_$PIECE("SET^KILL",U,DIK)_" LOGIC---",!!,"ENTER THE NAME OF A 'BULLETIN' MESSAGE, IF YOU WANT THAT MESSAGE SENT"
+1 DO GET^DICE2
if U[X
QUIT
SET DIC=3.6
SET DIC(0)="ELMQ"
SET DIC("DR")=".01;2;4;11;10"
DO ^DIC
KILL DIC,DICOMPX
if Y<0
GOTO M
+2 SET (DREF,^UTILITY("DICE",$JOB,$PIECE("CREA^DELE",U,DIK)_"TE VALUE"))=$PIECE(Y,U,2)
SET DCOND=DI_U_DL_U_DIK_U_DQ
+3 SET DIE=3.6
SET DA=+Y
SET DR=10
if '$PIECE(Y,U,3)
DO ^DIE
SET X=DREF
SET DI=$PIECE(DCOND,U,1)
SET DL=$PIECE(DCOND,U,2)
SET DIK=$PIECE(DCOND,U,3)
SET DQ=$PIECE(DCOND,U,4)
QUIT
+4 ;
S WRITE " ..OK",!
SET DHI=DHI+1
SS SET DLOC="PARAMETER #"_DHI
IF DHI>1
WRITE !,"NOW, IF THE BULLETIN IS TO HAVE "_DHI_" OR MORE PARAMETERS INSERTED,"
+1 WRITE !,"ENTER A FIELD NAME (FOR EXAMPLE, '"_DOLD_"'),",!,"OR A 'COMPUTED-FIELD' EXPRESSION,",!,"THE VALUE OF WHICH WILL BE PASSED INTO THE '"_DREF_"' MESSAGE,",!,"AS "_DLOC
+2 SET X=$ORDER(^XMB(3.6,"B",DREF,0))
if X=""
SET X=-1
IF X
FOR Y=1:1
if '$DATA(^XMB(3.6,X,4,Y,0))
QUIT
IF ^(0)=DHI
FOR D=1:1
if '$DATA(^XMB(3.6,X,4,Y,1,D,0))
GOTO T
WRITE !?4,"-- ",^(0)
+3 WRITE !,"(NOTE THAT NO SUCH PARAMETER IS DEFINED FOR THE '"_DREF_"' BULLETIN)"
T WRITE !
DO OLD^DICE2
WRITE DLOC_": "
READ X:DTIME
if '$TEST
SET DTOUT=1
if X?.P
if X=U!'$TEST
GOTO QQ
if X=""
GOTO SET
GOTO SS
SET DSUB=X
SET DICOMP="?"
DO ^DICOMP
IF $DATA(X)-1
WRITE $CHAR(7),"??",!
GOTO SS
+1 SET DHI(DHI)=X_$PIECE(" S Y=X X ^DD(""DD"") S X=Y",1,Y["D")
SET ^UTILITY("DICE",$JOB,$PIECE("CREA^DELE",U,DIK)_"TE "_DLOC)=DSUB
GOTO S
SET WRITE !
+1 SET ^UTILITY("DICE",$JOB,DIK)="K XMY S XMB="""_DREF_""" D ^XMB:$D(^XMB(3.6,""B"",XMB)) K Y,XMB"
+2 ;
+3 FOR D=1:1
if '$DATA(DHI(D))
QUIT
Begin DoDot:1
+4 SET X="S X=Y(0) "_DHI(D)_" S XMB("_D_")=X"
+5 SET %=DIK_"."_$EXTRACT("00",1,3-$LENGTH(D))_D
+6 SET ^UTILITY("DICE",$JOB,+%)=X
End DoDot:1
+7 ;
+8 SET Y=""
+9 if $DATA(DHI(1))#2
SET Y=" X ""N DIIND F DIIND="_DIK_".001:.001 Q:$D("_DA_"DIIND))[0 X ^(DIIND)"""
+10 SET I="S Y(0)=X,D"_N_"=DA"
FOR %=1:1:N
SET I=I_",D"_(N-%)_"=DA("_%_")"
+11 ;
+12 IF $LENGTH(DLAY)
Begin DoDot:1
+13 SET Y=" I X"_Y
+14 if $LENGTH(I)+$LENGTH(Y)+$LENGTH(DLAY)+$LENGTH(^(DIK))>238
SET ^(DIK+.9)=DLAY
SET DLAY="X "_DA_(DIK+.9)_")"
+15 SET DLAY=" "_DLAY
End DoDot:1
+16 ;
+17 if Y]""!$LENGTH(DLAY)
SET ^(DIK)=I_DLAY_Y_" "_^(DIK)
