source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTAPI8.m@ 1211

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1YTAPI8 ;ASF/ALB- ASI PROCEEDURES ;7/26/01 11:35
2 ;;5.01;MENTAL HEALTH;**67,71**;Dec 30, 1994
3ADDER(YSDATA) ;add new record
4 N DIC,DLAYGO,X,Y
5 S DLAYGO=604,DIC(0)="L",DIC="^YSTX(604,",X="NEW"
6 D ^DIC
7 I Y'>0 S YSDATA(1)="[ERROR]",YSDATA(2)=-1 Q ;->out
8 S YSDATA(1)="[DATA]",YSDATA(2)=+Y
9 Q
10 ;GET ASI STORED DATA
11GETASI(YSDATA,YS) ;NEEDS IEN FOR FILE 604,DFN
12 ;Field #^Question^Required^Answer
13 N YSIEN,DFN,G,N,N1,X,YSN
14 S YSIEN=$G(YS("IEN"))
15 S DFN=$G(YS("DFN"))
16 I YSIEN'>0!('$D(^YSTX(604,YSIEN))) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD IEN" Q ; --->
17 I $P(^YSTX(604,YSIEN,0),U,2)'=DFN S YSDATA(1)="[ERROR]",YSDATA(2)="BAD DFN MATCH" Q ;--->OUT
18 S YSDATA(1)="[DATA]"
19 S YSDATA(2)=.02_U_"NAME"_U_1_U_$$GET1^DIQ(604,YSIEN_",",.02,"E")
20 S YSDATA(3)=.51_U_"ELECTRONICALLY SIGNED"_U_1_U_$$GET1^DIQ(604,YSIEN_",",.51,"E")
21 S YSN=3
22DCROSS S N=0
23 F S N=$O(^YSTX(604.66,"D",N)) Q:N'>0 D
24 . S N1=$O(^YSTX(604.66,"D",N,0))
25 . S G=^YSTX(604.66,N1,0)
26 . S X=$$GET1^DIQ(604,YSIEN_",",N,"E")
27 . S YSN=YSN+1
28 . S YSDATA(YSN)=N_U_$P(G,U,2)_U_$P(G,U,8)_U_X
29 Q
30LISTASI(YSDATA,YS) ;ASI LISTER
31 ;REQUIRES: DFN
32 ;RETURNS: IEN^DATE OF INTERVIEW^CLASS^SPECIAL^ESIGNED
33 ;0 RETURNED IF NO ADMINS
34 N DFN,YSIEN,YSN
35 S DFN=$G(YS("DFN"))
36 I DFN<1 S YSDATA(1)="[ERROR]",YSDATA(2)="BAD DFN" Q ;--->OUT
37 S YSDATA(1)="[DATA]",YSDATA(2)=0
38 S YSN=1
39 S YSIEN=0
40 F S YSIEN=$O(^YSTX(604,"C",DFN,YSIEN)) Q:YSIEN'>0 D
41 . S YSN=YSN+1
42 . S YSDATA(YSN)=YSIEN_U_$$FMTE^XLFDT($$GET1^DIQ(604,YSIEN_",",.05,"I"),"5ZD")_U_$$GET1^DIQ(604,YSIEN_",",.04,"E")_U_$$GET1^DIQ(604,YSIEN_",",.11,"E")_U_$$GET1^DIQ(604,YSIEN_",",.51,"E")_U_$$GET1^DIQ(604,YSIEN_",",.09,"E")
43 Q
44SIGNOK(YSDATA,YSIEN) ; all reqiured fields
45 ;ysflag 1= ok 0= missing 2=SPECIAL
46 N N1,YSASCLS,X,YSASFLD,YSF,YSASSPL,YSN,YSFLAG
47 S YSFLAG=1
48 I '$D(^YSTX(604,YSIEN,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="BAD IEN" Q
49 S YSDATA(1)="[DATA]",YSDATA(2)="1^OK TO SIGN"
50 S YSN=2
51 S YSASCLS=$$GET1^DIQ(604,YSIEN_",",.04,"I")
52 S YSASCLS=YSASCLS+3
53 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)))
54 . S YSASFLD=$P(^YSTX(604.66,N1,0),U,3)
55 . D TYPE
56 .; S YSF=$S(YSASFLD>10.02&(YSASFLD<10.44):"I",$P(^DD(604,YSASFLD,0),U,2)?1"P".E:"",1:"I")
57 . S YSF=$S(YSASFLD>10.02&(YSASFLD<10.44):"I",YSTYPE=1:"",1:"I")
58 . S X=$$GET1^DIQ(604,YSIEN,YSASFLD,YSF)
59 . S:X="" YSFLAG=0,YSN=YSN+1,YSDATA(YSN)=^YSTX(604,66,N1,0)
60 S X=$$GET1^DIQ(604,YSIEN,YSASFLD,.11)
61 S:X="X"!(X="N") YSFLAG=2
62 S:YSFLAG=0 YSDATA(2)="0^MISSING REQUIRED FIELDS"
63 S:YSFLAG=2 YSDATA(2)="2^A G12 RECORD"
64 Q
65TYPE ;check field type
66 ;O = NOT A POINTER 1 = POINTER
67 N YSFLD,YSTYPE
68 S YSTYPE=0
69 D FIELD^DID(604,YSASFLD,"","TYPE","YSFLD")
70 S:YSFLD("TYPE")="POINTER" YSTYPE=1
71 Q
72SIGN(YSDATA,YS) ; API for /es/
73 N YSCODE,YSASINTV,YSASTRS,VALID
74 S YSCODE=$G(YS("CODE"))
75 I YSCODE="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO SIG SENT" Q
76 S YSIEN=$G(YS("YSIEN"))
77 I YSIEN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="NO REC NUMBER" Q
78 I '$D(^YSTX(604,YSIEN)) S YSDATA(1)="[ERROR]",YSDATA(2)="NO REC FOUND" Q
79 S VALID=$$VALIDATE($$DECRYP^XUSRB1(YSCODE))
80 I +VALID'>0 S YSDATA(1)="[DATA]",YSDATA(2)="0^Bad EScode, not signed" Q
81 S YSASINTV=$$GET1^DIQ(604,YSIEN_",",.09,"I") ;INTERVERER
82 S YSASTRS=$$GET1^DIQ(604,YSIEN_",",.14,"I") ;TRANSCRIBER
83 I YSASINTV=DUZ,DUZ>0 D Q ;---> OUT
84 . D CR^YSASCR(YSIEN,YSASINTV,"")
85 . S YSDATA(1)="[DATA]",YSDATA(2)="1^ASI SIGNED"
86 I YSASTRS=DUZ,DUZ>0 D Q ;---> OUT
87 . D CONV^YSASCR(YSIEN,YSASINTV)
88 . D BUL^YSASBUL(YSIEN,YSASTRS,YSASINTV)
89 . S YSDATA(1)="[DATA]",YSDATA(2)="0^TRANSCRIBER SEND BULLETIN"
90 S YSDATA(1)="[ERROR]",YSDATA(2)="BAD LOGIC"
91 Q
92VALIDATE(X) ; Validate /es/-code
93 N YSY S YSY=0
94 D HASH^XUSHSHP I X]"",(X=$P($G(^VA(200,+DUZ,20)),U,4)) S YSY=1
95 Q YSY
Note: See TracBrowser for help on using the repository browser.