| [613] | 1 | YSASOSR ;WHITE CITY/DCL - BUILD ASI OUTPUT IN ARRAY BY DOMAIN ;1/13/97 09:55
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**24**;Dec 30, 1994
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | CSR(YSI2DA,YSI2R,YSI2SR) ;Converts Status Report fields to text, pass IEN and Target Root and Script Root.
|
|---|
| 6 | Q:$G(YSI2SR)=""
|
|---|
| 7 | Q:$D(@YSI2SR)'>9
|
|---|
| 8 | Q:'$G(YSI2DA)
|
|---|
| 9 | Q:$G(YSI2R)']""
|
|---|
| 10 | N YSI2N,YSI2NC,YSI2TR,YSI2N2,YSI2S,YSI2WP
|
|---|
| 11 | S YSI2N=0,YSI2NC=$O(@YSI2R@(""),-1)+1,YSI2TR="YSI2WP"
|
|---|
| 12 | F S YSI2N=$O(@YSI2SR@(YSI2N)) Q:YSI2N'>0 D
|
|---|
| 13 | .Q:'$D(@YSI2SR@(YSI2N,0)) S YSI2S=^(0)
|
|---|
| 14 | .K @YSI2TR
|
|---|
| 15 | .S YSI2S=$$STR(YSI2S,YSI2DA,YSI2TR)
|
|---|
| 16 | .;Q:YSI2S=""
|
|---|
| 17 | .I $D(@YSI2TR)'>9,$L(YSI2S)>79 D Q
|
|---|
| 18 | ..I $L(YSI2S," ")'>1 D Q
|
|---|
| 19 | ...S YSI2S=$E(YSI2S,1,79)
|
|---|
| 20 | ...Q
|
|---|
| 21 | ..N F,T,I,X
|
|---|
| 22 | ..S (F,T)=1,X=""
|
|---|
| 23 | ..F I=1:1:$L(YSI2S," ") S X=$P(YSI2S," ",F,I) D:$L(X)'<79
|
|---|
| 24 | ...S @YSI2R@(YSI2NC)=$P(YSI2S," ",F,I-1),YSI2NC=YSI2NC+1
|
|---|
| 25 | ...S F=I
|
|---|
| 26 | ...Q
|
|---|
| 27 | ..I $TR($P(YSI2S," ",F,245)," ")]"" S @YSI2R@(YSI2NC)=$P(YSI2S," ",F,245),YSI2NC=YSI2NC+1
|
|---|
| 28 | .I YSI2S]"" S @YSI2R@(YSI2NC)=YSI2S,YSI2NC=YSI2NC+1 Q
|
|---|
| 29 | .Q:$D(@YSI2TR)'>9
|
|---|
| 30 | .S YSI2N2=0
|
|---|
| 31 | .F S YSI2N2=$O(@YSI2TR@(YSI2N2)) Q:YSI2N2'>0 S @YSI2R@(YSI2NC)=@YSI2TR@(YSI2N2),YSI2NC=YSI2NC+1
|
|---|
| 32 | .Q
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | STR(YSI2X,YSI2IEN,YSI2TR) ;Extrinsic function. Pass string return resolved value
|
|---|
| 36 | ;STRING,IEN,wpTARGET ROOT - all required - CAN ONLY HANDLE 1 WP FIELD PER LINE
|
|---|
| 37 | Q:$G(YSI2X)']"" ""
|
|---|
| 38 | Q:$L(YSI2X,"|")'>2 YSI2X
|
|---|
| 39 | Q:$G(YSI2TR)']"" ""
|
|---|
| 40 | I $L(YSI2X,"/")=3 N YSI2G D Q:YSI2G="" $P(YSI2X,"/",3,99) Q $P(YSI2X,"/")_" "_$P($P(YSI2X,"/",2),"|")_YSI2G_$$STR($P($P(YSI2X,"/",2),"|",3,99),YSI2IEN,YSI2TR)_$P(YSI2X,"/",3,99)
|
|---|
| 41 | .N DIERR
|
|---|
| 42 | .S YSI2G=$$F($P(YSI2X,"|",2))
|
|---|
| 43 | .Q
|
|---|
| 44 | N YSI2I,YSI2Y,DIERR,YSI2Z
|
|---|
| 45 | S YSI2Y=""
|
|---|
| 46 | F YSI2I=1:1:$L(YSI2X,"|") D
|
|---|
| 47 | .I (YSI2I#2) S YSI2Y=YSI2Y_$P(YSI2X,"|",YSI2I) Q
|
|---|
| 48 | .Q:$TR($P(YSI2X,"|",YSI2I)," ")']""
|
|---|
| 49 | .S YSI2Z=$$F($P(YSI2X,"|",YSI2I))
|
|---|
| 50 | .S:'$D(@YSI2TR) YSI2Y=YSI2Y_YSI2Z
|
|---|
| 51 | .K DIERR
|
|---|
| 52 | .Q
|
|---|
| 53 | Q:$TR(YSI2Y," ")="" ""
|
|---|
| 54 | Q YSI2Y
|
|---|
| 55 | ;
|
|---|
| 56 | F(YSHF) ;return field value in database
|
|---|
| 57 | Q:$G(YSHF)=""
|
|---|
| 58 | N YSHX,DIERR
|
|---|
| 59 | S YSHX=$$GET1^DIQ(604,YSI2IEN,$P(YSHF,"^"),"",$G(YSI2TR))
|
|---|
| 60 | I $P(YSHF,"^",2) Q $J(YSHX,$P(YSHF,"^",2))
|
|---|
| 61 | Q YSHX
|
|---|
| 62 | ;
|
|---|
| 63 | TEST(X) ;
|
|---|
| 64 | N YSAS1,YSAS2,YSAS3
|
|---|
| 65 | S YSAS1=4,YSAS2="^TMP($J,""ASI"","_X_")",YSAS3="^YSTX(604.8,1,"_$G(X,10)_")"
|
|---|
| 66 | D CSR(YSAS1,YSAS2,YSAS3)
|
|---|
| 67 | Q
|
|---|
