source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQAPI14.m@ 635

Last change on this file since 635 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1YTQAPI14 ;ASF/ALB MHA PROCEEDURES ; 7/12/07 5:00pm
2 ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
3 Q
4SIGNOK(YSDATA,YS) ; all reqiured fields
5 ;Input: IENS as iens for 604
6 ;Output: 1^OK TO SIGN
7 ; 0^MISSING REQUIRED FIELDS
8 ; 2^A G12 RECORD
9 N N1,YSASCLS,X,YSASFLD,YSF,YSASSPL,YSN,YSFLAG,YSIEN,YSTYPE
10 S YSFLAG=1
11 S YSIEN=$G(YS("IENS"),-1)
12 I '$D(^YSTX(604,YSIEN,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD IEN" Q
13 S YSDATA(1)="[DATA]",YSDATA(2)="1^OK TO SIGN"
14 S YSN=2
15 S YSASCLS=$$GET1^DIQ(604,YSIEN_",",.04,"I")
16 S YSASCLS=YSASCLS+3
17 S N1=0 F S N1=$O(^YSTX(604.66,N1)) Q:N1'>0 D:($P(^YSTX(604.66,N1,0),U,8)&($P(^YSTX(604.66,N1,0),U,YSASCLS)))
18 . S YSASFLD=$P(^YSTX(604.66,N1,0),U,3)
19 . D TYPE
20 .; S YSF=$S(YSASFLD>10.02&(YSASFLD<10.44):"I",$P(^DD(604,YSASFLD,0),U,2)?1"P".E:"",1:"I")
21 . S YSF=$S(YSASFLD>10.02&(YSASFLD<10.44):"I",YSTYPE=1:"",1:"I")
22 . S X=$$GET1^DIQ(604,YSIEN,YSASFLD,YSF)
23 . S:X="" YSFLAG=0,YSN=YSN+1,YSDATA(YSN)=^YSTX(604.66,N1,0)
24 S X=$$GET1^DIQ(604,YSIEN,YSASFLD,.11)
25 S:X="X"!(X="N") YSFLAG=2
26 S:YSFLAG=0 YSDATA(2)="0^MISSING REQUIRED FIELDS"
27 S:YSFLAG=2 YSDATA(2)="2^A G12 RECORD"
28 Q
29TYPE ;check field type
30 ;O = NOT A POINTER 1 = POINTER
31 N YSFLD
32 S YSTYPE=0
33 D FIELD^DID(604,YSASFLD,"","TYPE","YSFLD")
34 S:YSFLD("TYPE")="POINTER" YSTYPE=1
35 Q
36SCOREIT(YSDATA,YS) ; from YTQAPI8
37 N N,N2,N4,R,S,YSAA,I,II,DFN,YSCODE,YSADATE,YSSCALE,YSBED,YSEND
38 K YSDATA,YSSONE
39 D PARSE^YTAPI(.YS)
40SCOR1 S (YSTEST,YSET)=$O(^YTT(601,"B",YSCODE,0))
41 S YSED=YSADATE
42 S YSDFN=DFN
43 S YSSX=$P(^DPT(DFN,0),U,2)
44 S YSTN=YSCODE
45 IF '$D(^YTD(601.2,YSDFN,1,YSET,1,YSED)) S YSDATA(1)="[ERROR SCORE1+5]",YSDATA(2)="no administration found" Q
46 D PRIV ;check it
47 S YSR(0)=$G(^YTT(601.6,YSET,0))
48 I $P(YSR(0),U,2)="Y" S X=^YTT(601.6,YSET,1) X X
49 Q:$G(YSDATA(1))?1"[ERROR".E
50 D SCORSET^YTAPI2
51 D:YSPRIV SF^YTAPI2
52 S N1=0
53 F S N1=$O(YSSONE(N1)) Q:N1'>0 S N=N+1,YSDATA(N)=YSSONE(N1)
54 D CLEAN^YSMTI5 Q
55PRIV ;check privileges
56 N YS71,YSKEY
57 S YSPRIV=0
58 S YS71=$O(^YTT(601.71,"B",YSTN,0))
59 Q:YS71'>0 ;-->out error
60 S YSKEY=$$GET1^DIQ(601.71,YS71_",",9)
61 I YSKEY="" S YSPRIV=1 Q ;-->out exempt
62 I $D(^XUSEC(YSKEY,DUZ)) S YSPRIV=1 Q ;-->out has key
63 Q
Note: See TracBrowser for help on using the repository browser.