- 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 Mar 13, 2025@21:18:02 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
