DICOMPY ;SFISC/GFT-EVALUATE COMPUTED FLD EXPR ;10:22 AM 8 Jan 2003
;;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.
;
N DICOINS,DICOLEFT
S K(K+1)=X,I=$E(I,M+1,999)
I I'[")" K Y Q
ARG D S DICOLEFT=$E(I,%+1,999),I=$E(I,1,%-1)
.N C,S S S=0
.F %=1:1 S C=$E(I,%) D:C="""" S:C="(" S=S+1 S:C=")" S=S-1 Q:S<0!(C="")
..F %=%+1:1 Q:""""[$E(I,%)
PREVNEXT I DICF="PREVIOUS"!(DICF="NEXT") N DICMX D D RCR^DICOMPZ(I) G BAD:'$D(Y) S DICN=X,X=DICF G OK
.D SV^DICOMPX(DLV0)
.S %=DLV#100,DICF=" S D"_%_"=+$O("_$$REF^DICOMPZ(DLV)_")"_$P(",-1",U,DICF="PREVIOUS")_") "
D FUNC
N DICMX S DICMX=DICOINS
D RCR^DICOMPZ(I) I $G(Y)'["m" G BAD
OK S K=K+1,K(K)=X,K(K,2)=0,K=K+1,K(K)=DICN I "TOTAL"=DICF!("COUNT"=DICF) K DATE(K-1)
RES S I=DICOLEFT,M=0 Q
;
FUNC S DICN=$$DGI^DICOMP,W=DLV#100,K=K+2,K(K)=" S "_DICN_"="""""
NUMBER I DICF S %X=$$DGI^DICOMP,K(K)=" S "_%X_"=0"_K(K) D L S DICOINS=DICOINS_" "_%X_"="_%X_"+1 I "_%X_"="_+DICF_",Y'?."" "" S "_DICN_"=Y Q ",DPS(DPS,"O")="" Q
I $T(@DICF)]"" G @DICF
BAD S DPS=0 Q
;
;
MAXIMUM S %X="'>" G MM
MINIMUM S %X="'<"
MM D L S DICOINS=DICOINS_"&("_DICN_%X_"Y!'$L("_DICN_")) "_DICN_"=Y" Q
TOTAL S DICOINS="S "_DICN_"="_DICN_"+X" Q
COUNT S DICOINS="S:X'?."" "" "_DICN_"="_DICN_"+1",DICN="+"_DICN Q
LAST D L S DICOINS=DICOINS_" "_DICN_"=Y" Q
L S DICOINS="S Y=X S:Y'?."" """
Q
;
;
W S X=$P(Y(0),U,4),Y=$P(X,";",1),X=$P(X,";",2) Q
;
DICS ;
S:DUZ(0)'="@" D=DICOMP["W"+8,DIC("S")=DIC("S")_" Q:'$L($G("_DIC_"Y,"_D_"))) I $TR(DUZ(0),^("_D_"))'=DUZ(0)" Q
G ;
D W I X="" S Y=T#100,X=$S(T<DLV0&$D(M(Y,T))!(DICOMP["T"&(T<DICO(0))):$S(DA:DQI_(T+80)_")",1:"I("_T_",0)"),1:"$S('$D(D"_Y_"):"""",D"_Y_"<0:"""",1:D"_Y_")") Q
I '$D(DG(%,T_U_Y)) S (DG(%),DG(%,T_U_Y))=DG(%)+1
S Y="("_DQI_DG(%,T_U_Y)_"),"
EP I X S X="$P"_Y_"U,"_X_")" Q
I X?1"E".E S X="$E"_Y_+$E(X,2,9)_","_$P(X,",",2)_")"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDICOMPY 2118 printed Dec 13, 2024@02:46:31 Page 2
DICOMPY ;SFISC/GFT-EVALUATE COMPUTED FLD EXPR ;10:22 AM 8 Jan 2003
+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 NEW DICOINS,DICOLEFT
+8 SET K(K+1)=X
SET I=$EXTRACT(I,M+1,999)
+9 IF I'[")"
KILL Y
QUIT
ARG Begin DoDot:1
+1 NEW C,S
SET S=0
+2 FOR %=1:1
SET C=$EXTRACT(I,%)
if C=""""
Begin DoDot:2
+3 FOR %=%+1:1
if """"[$EXTRACT(I,%)
QUIT
End DoDot:2
if C="("
SET S=S+1
if C=")"
SET S=S-1
if S<0!(C="")
QUIT
End DoDot:1
SET DICOLEFT=$EXTRACT(I,%+1,999)
SET I=$EXTRACT(I,1,%-1)
PREVNEXT IF DICF="PREVIOUS"!(DICF="NEXT")
NEW DICMX
Begin DoDot:1
+1 DO SV^DICOMPX(DLV0)
+2 SET %=DLV#100
SET DICF=" S D"_%_"=+$O("_$$REF^DICOMPZ(DLV)_")"_$PIECE(",-1",U,DICF="PREVIOUS")_") "
End DoDot:1
DO RCR^DICOMPZ(I)
if '$DATA(Y)
GOTO BAD
SET DICN=X
SET X=DICF
GOTO OK
+3 DO FUNC
+4 NEW DICMX
SET DICMX=DICOINS
+5 DO RCR^DICOMPZ(I)
IF $GET(Y)'["m"
GOTO BAD
OK SET K=K+1
SET K(K)=X
SET K(K,2)=0
SET K=K+1
SET K(K)=DICN
IF "TOTAL"=DICF!("COUNT"=DICF)
KILL DATE(K-1)
RES SET I=DICOLEFT
SET M=0
QUIT
+1 ;
FUNC SET DICN=$$DGI^DICOMP
SET W=DLV#100
SET K=K+2
SET K(K)=" S "_DICN_"="""""
NUMBER IF DICF
SET %X=$$DGI^DICOMP
SET K(K)=" S "_%X_"=0"_K(K)
DO L
SET DICOINS=DICOINS_" "_%X_"="_%X_"+1 I "_%X_"="_+DICF_",Y'?."" "" S "_DICN_"=Y Q "
SET DPS(DPS,"O")=""
QUIT
+1 IF $TEXT(@DICF)]""
GOTO @DICF
BAD SET DPS=0
QUIT
+1 ;
+2 ;
MAXIMUM SET %X="'>"
GOTO MM
MINIMUM SET %X="'<"
MM DO L
SET DICOINS=DICOINS_"&("_DICN_%X_"Y!'$L("_DICN_")) "_DICN_"=Y"
QUIT
TOTAL SET DICOINS="S "_DICN_"="_DICN_"+X"
QUIT
COUNT SET DICOINS="S:X'?."" "" "_DICN_"="_DICN_"+1"
SET DICN="+"_DICN
QUIT
LAST DO L
SET DICOINS=DICOINS_" "_DICN_"=Y"
QUIT
L SET DICOINS="S Y=X S:Y'?."" """
+1 QUIT
+2 ;
+3 ;
W SET X=$PIECE(Y(0),U,4)
SET Y=$PIECE(X,";",1)
SET X=$PIECE(X,";",2)
QUIT
+1 ;
DICS ;
+1 if DUZ(0)'="@"
SET D=DICOMP["W"+8
SET DIC("S")=DIC("S")_" Q:'$L($G("_DIC_"Y,"_D_"))) I $TR(DUZ(0),^("_D_"))'=DUZ(0)"
QUIT
G ;
+1 DO W
IF X=""
SET Y=T#100
SET X=$SELECT(T<DLV0&$DATA(M(Y,T))!(DICOMP["T"&(T<DICO(0))):$SELECT(DA:DQI_(T+80)_")",1:"I("_T_",0)"),1:"$S('$D(D"_Y_"):"""",D"_Y_"<0:"""",1:D"_Y_")")
QUIT
+2 IF '$DATA(DG(%,T_U_Y))
SET (DG(%),DG(%,T_U_Y))=DG(%)+1
+3 SET Y="("_DQI_DG(%,T_U_Y)_"),"
EP IF X
SET X="$P"_Y_"U,"_X_")"
QUIT
+1 IF X?1"E".E
SET X="$E"_Y_+$EXTRACT(X,2,9)_","_$PIECE(X,",",2)_")"
+2 QUIT
