Routine: YTAPI5

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

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

RSCORE ; raw scores

 S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,3)

SSCORE ;scaled score

 S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,4)

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

MC ;mumps executable setting P

 S YSMC=$P(P,";",2)

 X YSMC

GAFURL(YSDATA) ;returns MH GAF horizontal sheet

 S YSDATA(1)="[DATA]"

 S YSDATA(2)="http://vaww.mentalhealth.domain.ext/gafsheet" ;ASF 10/13/11

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"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTAPI5   2972     printed  Feb 18, 2025@23:43:08                                                                                                                                                                                                      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

YTAPI5.m