source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQAPI6.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1YTQAPI6 ;ALB/ASF- GAF API,DELETES ; 10/26/06 3:33pm
2 ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
3GAFRET(YSDATA,YS) ;
4 N YSBEG,YSEND,YSLIMIT,N,DFN,%DT
5 K YSDATA
6 D PARSE(.YS)
7 I DFN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="No dfn" Q
8 S YSDATA(1)="[DATA]"
9 S N=1
10 D RETHX
11 Q
12PARSE(YS) ; -- array parsing
13 S DFN=$G(YS("DFN"),0)
14 S YSBEG=$G(YS("BEGIN"),"01/01/1970") S X=YSBEG,%DT="X" D ^%DT S YSBEG=Y
15 S YSEND=$G(YS("END"),"01/01/2500") S X=YSEND,%DT="X" D ^%DT S YSEND=Y
16 S YSLIMIT=$G(YS("LIMIT"),9999)
17 Q
18RETHX ;
19 N YSJJ,YSDD,X,Y,YSX,YSN
20 S YSDD=9999999-YSEND-.00001
21 F YSJJ=1:1:YSLIMIT S YSDD=$O(^YSD(627.8,"AX5",DFN,YSDD)) Q:YSDD'>0!(YSDD>(9999999-YSBEG)) D
22 . S YSN=0 F S YSN=$O(^YSD(627.8,"AX5",DFN,YSDD,YSN)) Q:YSN'>0 D
23 .. S YSX=$P($G(^YSD(627.8,YSN,60)),U,3)
24 .. S Y=$P($G(^YSD(627.8,YSN,0)),U,3)
25 .. S YSX=YSN_"="_$$FMTE^XLFDT(Y,"5TZ")_U_YSX_U_$P(^YSD(627.8,YSN,0),U,4)_U_$$EXTERNAL^DILFD(627.8,.04,"",$P($G(^YSD(627.8,YSN,0)),U,4))_U_$G(^YSD(627.8,YSN,80,1,0))
26 .. D SET(YSX)
27 Q
28SET(X) ;
29 S N=N+1
30 S YSDATA(N)=X
31 Q
32DELETEME(YSDATA,YS) ;delete a test
33 ;removes 601.71 and 601.76 entries only
34 ;input: CODE as test name
35 ;output: DATA vs ERROR
36 N YSTESTN,YSTEST,YSHASOP,DA,DIK
37 S YSTEST=$G(YS("CODE"))
38 I YSTEST="" S YSDATA(1)="[ERROR]",YSDATA(2)="NO code" Q ;-->out
39 S YSTESTN=$O(^YTT(601.71,"B",YSTEST,0))
40 I YSTESTN'>0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad code" Q ;-->out
41 S YSHASOP=$P($G(^YTT(601.71,YSTESTN,2)),U,5)
42 I YSHASOP="Y" S YSDATA(1)="[ERROR]",YSDATA(2)="has been operational" Q ;--> out
43 S DA=YSTESTN,DIK="^YTT(601.71," D ^DIK
44 S DIK="^YTT(601.76,"
45 S DA=0 F S DA=$O(^YTT(601.76,"AC",YSTESTN,DA)) Q:DA'>0 D ^DIK
46 S YSDATA(1)="[DATA]"
47 Q
Note: See TracBrowser for help on using the repository browser.