- DICE7 ;SFISC/GFT-BULLETIN X-REFS ;12:38 PM 8 Jun 1995
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- 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)
- DICE7 ;SFISC/GFT-BULLETIN X-REFS ;12:38 PM 8 Jun 1995
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 KILL ^UTILITY("DICE",$JOB)
- SET ^($JOB,0)="^^BULLETIN MESSAGE"
- SET DOLD=$PIECE(^DD(DI,DL,0),U,1)
- +4 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
- +5 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)
