Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTAPI5.m

    r613 r623  
    1 YTAPI5  ;ALB/ASF- MH API NOTES ; 7/24/07 4:11pm
    2         ;;5.01;MENTAL HEALTH;**62,85**;Dec 30, 1994;Build 49
    3         Q
    4 OUTNOTE(YSDATA) ;
    5         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
    6         I $G(YSDATA(1))?1"[ERROR".E Q  ;---->
    7         I '$D(YSDATA(5)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad ysdata to outnote" Q  ;--->
    8         S YS2=$G(YSDATA(2))
    9         S YSCODE=$P(YS2,U,2)
    10         S YSADATE=$P(YS2,U,4)
    11         S YSNCODE=$O(^YTT(601,"B",YSCODE,-1))
    12         S YSX1=$P(YSDATA(3),U,2)
    13         S YSX2=$P(YSDATA(4),U,2)
    14         S YSX3=$P(YSDATA(5),U,2)
    15         S YSSR=$P(YSDATA(6),U,3)
    16         S YSST=$P(YSDATA(6),U,4)
    17         S Y=$G(^YTT(601.6,YSNCODE,2))
    18         I Y="" S YSDATA(1)="[ERROR]",YSDATA(2)="no mh mult outcome code" Q  ;--->
    19         ;
    20         X Y
    21         I X'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad M executable" Q  ;--->
    22 LD      ;LOAD NOTE
    23         S N=0
    24         F  S N=$O(^YTT(601.6,YSNCODE,3,X,1,N)) Q:N'>0  D
    25         . S YSDATA("ON",N,0)=^YTT(601.6,YSNCODE,3,X,1,N,0)
    26 REP     ;replace ||
    27         S N=0
    28         F  S N=$O(YSDATA("ON",N)) Q:N'>0  D
    29         . S G=YSDATA("ON",N,0)
    30         . S R=""
    31         . F I=1:1:$L(G,"|") D
    32         .. S P=$P(G,"|",I)
    33         .. D:P?1"RSCORE".1N.N RSCORE
    34         .. D:P?1"SSCORE".1N.N SSCORE
    35         .. D:P?1"ITEM".1N.E ITEM
    36         .. D:P?1"EXECUTE".E MC
    37         .. S R=R_P
    38         . S YSDATA("ON",N,0)=R
    39         Q
    40 RSCORE  ; raw scores
    41         S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,3)
    42         Q
    43 SSCORE  ;scaled score
    44         S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,4)
    45         Q
    46 ITEM    ;items resolution
    47         S YSIN=$E(P,5,999)
    48         S YSSET=$P(YSIN,";",2)
    49         S YSIN=$P(YSIN,";",1)
    50         S YSINN=$S(YSIN>400:5,YSIN>200:4,1:3)
    51         S YSINE=$S(YSIN#200=0:200,1:YSIN)
    52         S P=$P(YSDATA(YSINN),U,2)
    53         S P=$E(P,YSINE)
    54         Q:YSSET=""
    55         F YSJJ=1:1:$L(YSSET,",") D
    56         . S YSGG=$P(YSSET,",",YSJJ),YSGG1=$P(YSGG,":"),YSGG2=$P(YSGG,":",2)
    57         . S:P=YSGG1 P=YSGG2
    58         Q
    59 MC      ;mumps executable setting P
    60         S YSMC=$P(P,";",2)
    61         X YSMC
    62         Q
    63 GAFURL(YSDATA)  ;returns MH GAF horizontal sheet
    64         S YSDATA(1)="[DATA]"
    65         S YSDATA(2)="http://vaww.mentalhealth.med.va.gov/gafsheet.htm"
    66         Q
    67 PRIVL(YSDATA,YS)        ;check privileges
    68         N YSCODE,YSET
    69         S YSCODE=$G(YS("CODE"),-1)
    70         ;ASF 03/08/06
    71         I (YSCODE="GAF")!(YSCODE="ASI") S YSDATA(1)="[DATA]",YSDATA(2)="1^exempt test" Q  ;-->out test exempt
    72         I $D(^YTT(601.71,"B",YSCODE)) D  Q  ;--> out
    73         . S YSET=$O(^YTT(601.71,"B",YSCODE,0))
    74         . S YSDATA(1)="[DATA]"
    75         . S YSKEY=$$GET1^DIQ(601.71,YSET_",",9)
    76         . I YSKEY="" S YSDATA(2)="1^exempt test" Q  ;-->out
    77         . I $D(^XUSEC(YSKEY,DUZ)) S YSDATA(2)="1^user privileged" Q  ;-->out has key
    78         . S YSDATA(2)="0^no access" Q  ;->out
    79         ;
    80         I '$D(^YTT(601,"B",YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD TEST CODE" Q  ;--> out
    81         S YSET=$O(^YTT(601,"B",YSCODE,0))
    82         S YSDATA(1)="[DATA]"
    83         I $D(^XUSEC("YSP",DUZ)) S YSDATA(2)="1^user privileged for all tests" Q  ;has key
    84         I $P(^YTT(601,YSET,0),U,10)="Y"!(YSCODE="GAF")!(YSCODE="ASI") S YSDATA(2)="1^exempt test" Q  ;test exempt
    85         I $P(^YTT(601,YSET,0),U,9)="I" S YSDATA(2)="1^interview" Q  ;interview
    86         S YSDATA(2)="0^no access"
    87         Q
     1YTAPI5 ;ALB/ASF- MH API NOTES ;3/17/00  14:54
     2 ;;5.01;MENTAL HEALTH;**62**;Dec 30, 1994
     3 Q
     4OUTNOTE(YSDATA) ;
     5 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
     6 I $G(YSDATA(1))?1"[ERROR".E Q  ;---->
     7 I '$D(YSDATA(5)) S YSDATA(1)="ERROR]",YSDATA(2)="bad ysdata to outnote" Q  ;--->
     8 S YS2=$G(YSDATA(2))
     9 S YSCODE=$P(YS2,U,2)
     10 S YSADATE=$P(YS2,U,4)
     11 S YSNCODE=$O(^YTT(601,"B",YSCODE,-1))
     12 S YSX1=$P(YSDATA(3),U,2)
     13 S YSX2=$P(YSDATA(4),U,2)
     14 S YSX3=$P(YSDATA(5),U,2)
     15 S YSSR=$P(YSDATA(6),U,3)
     16 S YSST=$P(YSDATA(6),U,4)
     17 S Y=$G(^YTT(601.6,YSNCODE,2))
     18 I Y="" S YSDATA(1)="[ERROR"],YSDATA(2)="no mh mult outcome code" Q  ;--->
     19 ;
     20 X Y
     21 I X'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad M executable" Q  ;--->
     22LD ;LOAD NOTE
     23 S N=0
     24 F  S N=$O(^YTT(601.6,YSNCODE,3,X,1,N)) Q:N'>0  D
     25 . S YSDATA("ON",N,0)=^YTT(601.6,YSNCODE,3,X,1,N,0)
     26REP ;replace ||
     27 S N=0
     28 F  S N=$O(YSDATA("ON",N)) Q:N'>0  D
     29 . S G=YSDATA("ON",N,0)
     30 . S R=""
     31 . F I=1:1:$L(G,"|") D
     32 .. S P=$P(G,"|",I)
     33 .. D:P?1"RSCORE".1N.N RSCORE
     34 .. D:P?1"SSCORE".1N.N SSCORE
     35 .. D:P?1"ITEM".1N.E ITEM
     36 .. D:P?1"EXECUTE".E MC
     37 .. S R=R_P
     38 . S YSDATA("ON",N,0)=R
     39 Q
     40RSCORE ; raw scores
     41 S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,3)
     42 Q
     43SSCORE ;scaled score
     44 S YSJ=$E(P,7,99),P=$P(YSDATA(YSJ+5),U,4)
     45 Q
     46ITEM ;items resolution
     47 S YSIN=$E(P,5,999)
     48 S YSSET=$P(YSIN,";",2)
     49 S YSIN=$P(YSIN,";",1)
     50 S YSINN=$S(YSIN>400:5,YSIN>200:4,1:3)
     51 S YSINE=$S(YSIN#200=0:200,1:YSIN)
     52 S P=$P(YSDATA(YSINN),U,2)
     53 S P=$E(P,YSINE)
     54 Q:YSSET=""
     55 F YSJJ=1:1:$L(YSSET,",") D
     56 . S YSGG=$P(YSSET,",",YSJJ),YSGG1=$P(YSGG,":"),YSGG2=$P(YSGG,":",2)
     57 . S:P=YSGG1 P=YSGG2
     58 Q
     59MC ;mumps executable setting P
     60 S YSMC=$P(P,";",2)
     61 X YSMC
     62 Q
     63GAFURL(YSDATA) ;returns MH GAF horizontal sheet
     64 S YSDATA(1)="[DATA]"
     65 S YSDATA(2)="http://vaww.mentalhealth.med.va.gov/gafsheet.htm"
     66 Q
     67PRIVL(YSDATA,YS) ;check privileges
     68 N YSCODE,YSET
     69 S YSCODE=$G(YS("CODE"),-1)
     70 I '$D(^YTT(601,"B",YSCODE)) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD TEST CODE" Q  ;--> out
     71 S YSET=$O(^YTT(601,"B",YSCODE,0))
     72 S YSDATA(1)="[DATA]"
     73 I $D(^XUSEC("YSP",DUZ)) S YSDATA(2)="1^user privileged for all tests" Q  ;has key
     74 I $P(^YTT(601,YSET,0),U,10)="Y"!(YSCODE="GAF")!(YSCODE="ASI") S YSDATA(2)="1^exempt test" Q  ;test exempt
     75 I $P(^YTT(601,YSET,0),U,9)="I" S YSDATA(2)="1^interview" Q  ;interview
     76 S YSDATA(2)="0^no access"
     77 Q
Note: See TracChangeset for help on using the changeset viewer.