YTAPI5 ;ALB/ASF - MH API NOTES ;11/14/11 1:03pm
;;5.01;MENTAL HEALTH;**62,85,106**;Dec 30, 1994;Build 10
;Reference to ^XUSEC( supported by DBIA #10076
Q
OUTNOTE(YSDATA) ;
N G,I,N,P,R,X,Y,YS2,YSADATE,YSCODE,YSGG,YSGG1,YSGG2,YSJ,YSJJ,YSNCODE,YSSET,YSSR,YSST,YSX1,YSX2,YSX3,YIN,YSINN,YSINE,YSMC
I $G(YSDATA(1))?1"[ERROR".E Q ;---->
I '$D(YSDATA(5)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad ysdata to outnote" Q ;--->
S YS2=$G(YSDATA(2))
S YSCODE=$P(YS2,U,2)
S YSADATE=$P(YS2,U,4)
S YSNCODE=$O(^YTT(601,"B",YSCODE,-1))
S YSX1=$P(YSDATA(3),U,2)
S YSX2=$P(YSDATA(4),U,2)
S YSX3=$P(YSDATA(5),U,2)
S YSSR=$P(YSDATA(6),U,3)
S YSST=$P(YSDATA(6),U,4)
S Y=$G(^YTT(601.6,YSNCODE,2))
I Y="" S YSDATA(1)="[ERROR]",YSDATA(2)="no mh mult outcome code" Q ;--->
;
X Y
I X'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad M executable" Q ;--->
LD ;LOAD NOTE
S N=0
F S N=$O(^YTT(601.6,YSNCODE,3,X,1,N)) Q:N'>0 D
. S YSDATA("ON",N,0)=^YTT(601.6,YSNCODE,3,X,1,N,0)
REP ;replace ||
S N=0
F S N=$O(YSDATA("ON",N)) Q:N'>0 D
. S G=YSDATA("ON",N,0)
. S R=""
. F I=1:1:$L(G,"|") D
.. S P=$P(G,"|",I)
.. D:P?1"RSCORE".1N.N RSCORE
.. D:P?1"SSCORE".1N.N SSCORE
.. D:P?1"ITEM".1N.E ITEM
.. D:P?1"EXECUTE".E MC
.. S R=R_P
. S YSDATA("ON",N,0)=R
Q
RSCORE ; raw scores
S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,3)
Q
SSCORE ;scaled score
S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,4)
Q
ITEM ;items resolution
S YSIN=$E(P,5,999)
S YSSET=$P(YSIN,";",2)
S YSIN=$P(YSIN,";",1)
S YSINN=$S(YSIN>400:5,YSIN>200:4,1:3)
S YSINE=$S(YSIN#200=0:200,1:YSIN)
S P=$P(YSDATA(YSINN),U,2)
S P=$E(P,YSINE)
Q:YSSET=""
F YSJJ=1:1:$L(YSSET,",") D
. S YSGG=$P(YSSET,",",YSJJ),YSGG1=$P(YSGG,":"),YSGG2=$P(YSGG,":",2)
. S:P=YSGG1 P=YSGG2
Q
MC ;mumps executable setting P
S YSMC=$P(P,";",2)
X YSMC
Q
GAFURL(YSDATA) ;returns MH GAF horizontal sheet
S YSDATA(1)="[DATA]"
S YSDATA(2)="http://vaww.mentalhealth.domain.ext/gafsheet" ;ASF 10/13/11
Q
PRIVL(YSDATA,YS) ;check privileges
N YSCODE,YSET
S YSCODE=$G(YS("CODE"),-1)
;ASF 03/08/06
I (YSCODE="GAF")!(YSCODE="ASI") S YSDATA(1)="[DATA]",YSDATA(2)="1^exempt test" Q ;-->out test exempt
I $D(^YTT(601.71,"B",YSCODE)) D Q ;--> out
. S YSET=$O(^YTT(601.71,"B",YSCODE,0))
. S YSDATA(1)="[DATA]"
. S YSKEY=$$GET1^DIQ(601.71,YSET_",",9)
. I YSKEY="" S YSDATA(2)="1^exempt test" Q ;-->out
. I $D(^XUSEC(YSKEY,DUZ)) S YSDATA(2)="1^user privileged" Q ;-->out has key
. S YSDATA(2)="0^no access" Q ;->out
;
I '$D(^YTT(601,"B",YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD TEST CODE" Q ;--> out
S YSET=$O(^YTT(601,"B",YSCODE,0))
S YSDATA(1)="[DATA]"
I $D(^XUSEC("YSP",DUZ)) S YSDATA(2)="1^user privileged for all tests" Q ;has key
I $P(^YTT(601,YSET,0),U,10)="Y"!(YSCODE="GAF")!(YSCODE="ASI") S YSDATA(2)="1^exempt test" Q ;test exempt
I $P(^YTT(601,YSET,0),U,9)="I" S YSDATA(2)="1^interview" Q ;interview
S YSDATA(2)="0^no access"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTAPI5 2972 printed Oct 16, 2024@18:17:33 Page 2
YTAPI5 ;ALB/ASF - MH API NOTES ;11/14/11 1:03pm
+1 ;;5.01;MENTAL HEALTH;**62,85,106**;Dec 30, 1994;Build 10
+2 ;Reference to ^XUSEC( supported by DBIA #10076
+3 QUIT
OUTNOTE(YSDATA) ;
+1 NEW G,I,N,P,R,X,Y,YS2,YSADATE,YSCODE,YSGG,YSGG1,YSGG2,YSJ,YSJJ,YSNCODE,YSSET,YSSR,YSST,YSX1,YSX2,YSX3,YIN,YSINN,YSINE,YSMC
+2 ;---->
IF $GET(YSDATA(1))?1"[ERROR".E
QUIT
+3 ;--->
IF '$DATA(YSDATA(5))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad ysdata to outnote"
QUIT
+4 SET YS2=$GET(YSDATA(2))
+5 SET YSCODE=$PIECE(YS2,U,2)
+6 SET YSADATE=$PIECE(YS2,U,4)
+7 SET YSNCODE=$ORDER(^YTT(601,"B",YSCODE,-1))
+8 SET YSX1=$PIECE(YSDATA(3),U,2)
+9 SET YSX2=$PIECE(YSDATA(4),U,2)
+10 SET YSX3=$PIECE(YSDATA(5),U,2)
+11 SET YSSR=$PIECE(YSDATA(6),U,3)
+12 SET YSST=$PIECE(YSDATA(6),U,4)
+13 SET Y=$GET(^YTT(601.6,YSNCODE,2))
+14 ;--->
IF Y=""
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="no mh mult outcome code"
QUIT
+15 ;
+16 XECUTE Y
+17 ;--->
IF X'>0
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="bad M executable"
QUIT
LD ;LOAD NOTE
+1 SET N=0
+2 FOR
SET N=$ORDER(^YTT(601.6,YSNCODE,3,X,1,N))
if N'>0
QUIT
Begin DoDot:1
+3 SET YSDATA("ON",N,0)=^YTT(601.6,YSNCODE,3,X,1,N,0)
End DoDot:1
REP ;replace ||
+1 SET N=0
+2 FOR
SET N=$ORDER(YSDATA("ON",N))
if N'>0
QUIT
Begin DoDot:1
+3 SET G=YSDATA("ON",N,0)
+4 SET R=""
+5 FOR I=1:1:$LENGTH(G,"|")
Begin DoDot:2
+6 SET P=$PIECE(G,"|",I)
+7 if P?1"RSCORE".1N.N
DO RSCORE
+8 if P?1"SSCORE".1N.N
DO SSCORE
+9 if P?1"ITEM".1N.E
DO ITEM
+10 if P?1"EXECUTE".E
DO MC
+11 SET R=R_P
End DoDot:2
+12 SET YSDATA("ON",N,0)=R
End DoDot:1
+13 QUIT
RSCORE ; raw scores
+1 SET YSJ=$EXTRACT(P,7,99)
SET P=$PIECE(YSDATA(YSJ+5),U,3)
+2 QUIT
SSCORE ;scaled score
+1 SET YSJ=$EXTRACT(P,7,99)
SET P=$PIECE(YSDATA(YSJ+5),U,4)
+2 QUIT
ITEM ;items resolution
+1 SET YSIN=$EXTRACT(P,5,999)
+2 SET YSSET=$PIECE(YSIN,";",2)
+3 SET YSIN=$PIECE(YSIN,";",1)
+4 SET YSINN=$SELECT(YSIN>400:5,YSIN>200:4,1:3)
+5 SET YSINE=$SELECT(YSIN#200=0:200,1:YSIN)
+6 SET P=$PIECE(YSDATA(YSINN),U,2)
+7 SET P=$EXTRACT(P,YSINE)
+8 if YSSET=""
QUIT
+9 FOR YSJJ=1:1:$LENGTH(YSSET,",")
Begin DoDot:1
+10 SET YSGG=$PIECE(YSSET,",",YSJJ)
SET YSGG1=$PIECE(YSGG,":")
SET YSGG2=$PIECE(YSGG,":",2)
+11 if P=YSGG1
SET P=YSGG2
End DoDot:1
+12 QUIT
MC ;mumps executable setting P
+1 SET YSMC=$PIECE(P,";",2)
+2 XECUTE YSMC
+3 QUIT
GAFURL(YSDATA) ;returns MH GAF horizontal sheet
+1 SET YSDATA(1)="[DATA]"
+2 ;ASF 10/13/11
SET YSDATA(2)="http://vaww.mentalhealth.domain.ext/gafsheet"
+3 QUIT
PRIVL(YSDATA,YS) ;check privileges
+1 NEW YSCODE,YSET
+2 SET YSCODE=$GET(YS("CODE"),-1)
+3 ;ASF 03/08/06
+4 ;-->out test exempt
IF (YSCODE="GAF")!(YSCODE="ASI")
SET YSDATA(1)="[DATA]"
SET YSDATA(2)="1^exempt test"
QUIT
+5 ;--> out
IF $DATA(^YTT(601.71,"B",YSCODE))
Begin DoDot:1
+6 SET YSET=$ORDER(^YTT(601.71,"B",YSCODE,0))
+7 SET YSDATA(1)="[DATA]"
+8 SET YSKEY=$$GET1^DIQ(601.71,YSET_",",9)
+9 ;-->out
IF YSKEY=""
SET YSDATA(2)="1^exempt test"
QUIT
+10 ;-->out has key
IF $DATA(^XUSEC(YSKEY,DUZ))
SET YSDATA(2)="1^user privileged"
QUIT
+11 ;->out
SET YSDATA(2)="0^no access"
QUIT
End DoDot:1
QUIT
+12 ;
+13 ;--> out
IF '$DATA(^YTT(601,"B",YSCODE))
SET YSDATA(1)="[ERROR]"
SET YSDATA(2)="BAD TEST CODE"
QUIT
+14 SET YSET=$ORDER(^YTT(601,"B",YSCODE,0))
+15 SET YSDATA(1)="[DATA]"
+16 ;has key
IF $DATA(^XUSEC("YSP",DUZ))
SET YSDATA(2)="1^user privileged for all tests"
QUIT
+17 ;test exempt
IF $PIECE(^YTT(601,YSET,0),U,10)="Y"!(YSCODE="GAF")!(YSCODE="ASI")
SET YSDATA(2)="1^exempt test"
QUIT
+18 ;interview
IF $PIECE(^YTT(601,YSET,0),U,9)="I"
SET YSDATA(2)="1^interview"
QUIT
+19 SET YSDATA(2)="0^no access"
+20 QUIT
