YSASOSR ;WHITE CITY/DCL - BUILD ASI OUTPUT IN ARRAY BY DOMAIN ;1/13/97 09:55
;;5.01;MENTAL HEALTH;**24,187**;Dec 30, 1994;Build 73
;
Q
CSR(YSI2DA,YSI2R,YSI2SR) ;Converts Status Report fields to text, pass IEN and Target Root and Script Root.
Q:$G(YSI2SR)=""
Q:$D(@YSI2SR)'>9
Q:'$G(YSI2DA)
Q:$G(YSI2R)']""
N YSI2N,YSI2NC,YSI2TR,YSI2N2,YSI2S,YSI2WP
S YSI2N=0,YSI2NC=$O(@YSI2R@(""),-1)+1,YSI2TR="YSI2WP"
F S YSI2N=$O(@YSI2SR@(YSI2N)) Q:YSI2N'>0 D
.Q:'$D(@YSI2SR@(YSI2N,0)) S YSI2S=^(0)
.K @YSI2TR
.S YSI2S=$$STR(YSI2S,YSI2DA,YSI2TR)
.;Q:YSI2S=""
.I $D(@YSI2TR)'>9,$L(YSI2S)>79 D Q
..I $L(YSI2S," ")'>1 D Q
...S YSI2S=$E(YSI2S,1,79)
...Q
..N F,T,I,X
..S (F,T)=1,X=""
..F I=1:1:$L(YSI2S," ") S X=$P(YSI2S," ",F,I) D:$L(X)'<79
...S @YSI2R@(YSI2NC)=$P(YSI2S," ",F,I-1),YSI2NC=YSI2NC+1
...S F=I
...Q
..I $TR($P(YSI2S," ",F,245)," ")]"" S @YSI2R@(YSI2NC)=$P(YSI2S," ",F,245),YSI2NC=YSI2NC+1
.I YSI2S]"" S @YSI2R@(YSI2NC)=YSI2S,YSI2NC=YSI2NC+1 Q
.Q:$D(@YSI2TR)'>9
.S YSI2N2=0
.F S YSI2N2=$O(@YSI2TR@(YSI2N2)) Q:YSI2N2'>0 S @YSI2R@(YSI2NC)=@YSI2TR@(YSI2N2),YSI2NC=YSI2NC+1
.Q
Q
;
STR(YSI2X,YSI2IEN,YSI2TR) ;Extrinsic function. Pass string return resolved value
;STRING,IEN,wpTARGET ROOT - all required - CAN ONLY HANDLE 1 WP FIELD PER LINE
Q:$G(YSI2X)']"" ""
Q:$L(YSI2X,"|")'>2 YSI2X
Q:$G(YSI2TR)']"" ""
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)
.N DIERR
.S YSI2G=$$F($P(YSI2X,"|",2))
.Q
N YSI2I,YSI2Y,DIERR,YSI2Z
S YSI2Y=""
F YSI2I=1:1:$L(YSI2X,"|") D
.I (YSI2I#2) S YSI2Y=YSI2Y_$P(YSI2X,"|",YSI2I) Q
.Q:$TR($P(YSI2X,"|",YSI2I)," ")']""
.S YSI2Z=$$F($P(YSI2X,"|",YSI2I))
.S:'$D(@YSI2TR) YSI2Y=YSI2Y_YSI2Z
.K DIERR
.Q
Q:$TR(YSI2Y," ")="" ""
Q YSI2Y
;
F(YSHF) ;return field value in database
Q:$G(YSHF)=""
I YSHF=".02:.09" Q "xxx-xx-"_$G(VA("BID"),"xxxx") ; don't show full SSN
N YSHX,DIERR
S YSHX=$$GET1^DIQ(604,YSI2IEN,$P(YSHF,"^"),"",$G(YSI2TR))
I $P(YSHF,"^",2) Q $J(YSHX,$P(YSHF,"^",2))
Q YSHX
;
TEST(X) ;
N YSAS1,YSAS2,YSAS3
S YSAS1=4,YSAS2="^TMP($J,""ASI"","_X_")",YSAS3="^YSTX(604.8,1,"_$G(X,10)_")"
D CSR(YSAS1,YSAS2,YSAS3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSASOSR 2300 printed Apr 09, 2024@21:24:49 Page 2
YSASOSR ;WHITE CITY/DCL - BUILD ASI OUTPUT IN ARRAY BY DOMAIN ;1/13/97 09:55
+1 ;;5.01;MENTAL HEALTH;**24,187**;Dec 30, 1994;Build 73
+2 ;
+3 QUIT
CSR(YSI2DA,YSI2R,YSI2SR) ;Converts Status Report fields to text, pass IEN and Target Root and Script Root.
+1 if $GET(YSI2SR)=""
QUIT
+2 if $DATA(@YSI2SR)'>9
QUIT
+3 if '$GET(YSI2DA)
QUIT
+4 if $GET(YSI2R)']""
QUIT
+5 NEW YSI2N,YSI2NC,YSI2TR,YSI2N2,YSI2S,YSI2WP
+6 SET YSI2N=0
SET YSI2NC=$ORDER(@YSI2R@(""),-1)+1
SET YSI2TR="YSI2WP"
+7 FOR
SET YSI2N=$ORDER(@YSI2SR@(YSI2N))
if YSI2N'>0
QUIT
Begin DoDot:1
+8 if '$DATA(@YSI2SR@(YSI2N,0))
QUIT
SET YSI2S=^(0)
+9 KILL @YSI2TR
+10 SET YSI2S=$$STR(YSI2S,YSI2DA,YSI2TR)
+11 ;Q:YSI2S=""
+12 IF $DATA(@YSI2TR)'>9
IF $LENGTH(YSI2S)>79
Begin DoDot:2
+13 IF $LENGTH(YSI2S," ")'>1
Begin DoDot:3
+14 SET YSI2S=$EXTRACT(YSI2S,1,79)
+15 QUIT
End DoDot:3
QUIT
+16 NEW F,T,I,X
+17 SET (F,T)=1
SET X=""
+18 FOR I=1:1:$LENGTH(YSI2S," ")
SET X=$PIECE(YSI2S," ",F,I)
if $LENGTH(X)'<79
Begin DoDot:3
+19 SET @YSI2R@(YSI2NC)=$PIECE(YSI2S," ",F,I-1)
SET YSI2NC=YSI2NC+1
+20 SET F=I
+21 QUIT
End DoDot:3
+22 IF $TRANSLATE($PIECE(YSI2S," ",F,245)," ")]""
SET @YSI2R@(YSI2NC)=$PIECE(YSI2S," ",F,245)
SET YSI2NC=YSI2NC+1
End DoDot:2
QUIT
+23 IF YSI2S]""
SET @YSI2R@(YSI2NC)=YSI2S
SET YSI2NC=YSI2NC+1
QUIT
+24 if $DATA(@YSI2TR)'>9
QUIT
+25 SET YSI2N2=0
+26 FOR
SET YSI2N2=$ORDER(@YSI2TR@(YSI2N2))
if YSI2N2'>0
QUIT
SET @YSI2R@(YSI2NC)=@YSI2TR@(YSI2N2)
SET YSI2NC=YSI2NC+1
+27 QUIT
End DoDot:1
+28 QUIT
+29 ;
STR(YSI2X,YSI2IEN,YSI2TR) ;Extrinsic function. Pass string return resolved value
+1 ;STRING,IEN,wpTARGET ROOT - all required - CAN ONLY HANDLE 1 WP FIELD PER LINE
+2 if $GET(YSI2X)']""
QUIT ""
+3 if $LENGTH(YSI2X,"|")'>2
QUIT YSI2X
+4 if $GET(YSI2TR)']""
QUIT ""
+5 IF $LENGTH(YSI2X,"/")=3
NEW YSI2G
Begin DoDot:1
+6 NEW DIERR
+7 SET YSI2G=$$F($PIECE(YSI2X,"|",2))
+8 QUIT
End DoDot:1
if YSI2G=""
QUIT $PIECE(YSI2X,"/",3,99)
QUIT $PIECE(YSI2X,"/")_" "_$PIECE($PIECE(YSI2X,"/",2),"|")_YSI2G_$$STR($PIECE($PIECE(YSI2X,"/",2),"|",3,99),YSI2IEN,YSI2TR)_$PIECE(YSI2X,"/",3,99)
+9 NEW YSI2I,YSI2Y,DIERR,YSI2Z
+10 SET YSI2Y=""
+11 FOR YSI2I=1:1:$LENGTH(YSI2X,"|")
Begin DoDot:1
+12 IF (YSI2I#2)
SET YSI2Y=YSI2Y_$PIECE(YSI2X,"|",YSI2I)
QUIT
+13 if $TRANSLATE($PIECE(YSI2X,"|",YSI2I)," ")']""
QUIT
+14 SET YSI2Z=$$F($PIECE(YSI2X,"|",YSI2I))
+15 if '$DATA(@YSI2TR)
SET YSI2Y=YSI2Y_YSI2Z
+16 KILL DIERR
+17 QUIT
End DoDot:1
+18 if $TRANSLATE(YSI2Y," ")=""
QUIT ""
+19 QUIT YSI2Y
+20 ;
F(YSHF) ;return field value in database
+1 if $GET(YSHF)=""
QUIT
+2 ; don't show full SSN
IF YSHF=".02:.09"
QUIT "xxx-xx-"_$GET(VA("BID"),"xxxx")
+3 NEW YSHX,DIERR
+4 SET YSHX=$$GET1^DIQ(604,YSI2IEN,$PIECE(YSHF,"^"),"",$GET(YSI2TR))
+5 IF $PIECE(YSHF,"^",2)
QUIT $JUSTIFY(YSHX,$PIECE(YSHF,"^",2))
+6 QUIT YSHX
+7 ;
TEST(X) ;
+1 NEW YSAS1,YSAS2,YSAS3
+2 SET YSAS1=4
SET YSAS2="^TMP($J,""ASI"","_X_")"
SET YSAS3="^YSTX(604.8,1,"_$GET(X,10)_")"
+3 DO CSR(YSAS1,YSAS2,YSAS3)
+4 QUIT
