source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQAPI4.m@ 1608

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

initial load of WorldVistAEHR
File size: 5.3 KB
RevLine 
[613]1YTQAPI4 ;ASF/ALB MHQ REMOTE PROCEEDURES CHOICE/CHOICETYPE ; 4/3/07 1:44pm
2 ;;5.01;MENTAL HEALTH;**85**;DEC 30,1994;Build 49
3 Q
4IDENTAE(YSDATA,YS) ;choiceidentifier add/edit
5 ;input:CT as Choicetype IEN
6 ; ID a N,0 or 1
7 ;Output: added or eddited
8 N DA,YSID
9 S YSCT=$G(YS("CT"))
10 I YSCT'?1N.N S YSDATA(1)="[ERROR]",YSDATA(2)="bad CT" Q ;-->out
11 I '$D(^YTT(601.751,"B",YSCT)) S YSDATA(1)="[ERROR]",YSDATA(2)=YSCT_"^not found" Q ;-->out
12 S YSID=$G(YS("ID"))
13 I (YSID'="1")&(YSID'="0")&(YSID'="N") S YSDATA(1)="[ERROR]",YSDATA(1)="bad id" Q ;--out
14 I $D(^YTT(601.89,"B",YSCT)) S DA=$O(^YTT(601.89,"B",YSCT,0)) S $P(^YTT(601.89,DA,0),U,2)=YSID,YSDATA(2)="eddited" Q ;good edit
15 L +^YTT(601.89):30
16 S DA=$$NEW^YTQLIB(601.89)
17 S ^YTT(601.89,DA,0)=YSCT_U_YSID
18 S DIK="^YTT(601.89,"
19 D IX1^DIK
20 L -^YTT(601.89)
21 S YSDATA(1)="[DATA]",YSDATA(2)=DA_"^added"
22 Q
23TESTADD(YSDATA,YS) ;add new instrument
24 ;input:CODE must be unique
25 ;Output: new ien^added
26 N DA,YSCODE
27 S YSCODE=$G(YS("CODE"))
28 I ($L(YSCODE)>50)!($L(YSCODE)<3) S YSDATA(1)="[ERROR]",YSDATA(2)="bad ins name" Q ;-->out
29 I $D(^YTT(601.71,"B",YSCODE)) S DA=$O(^YTT(601.75,"B",YSCODE,0)),YSDATA(1)="[ERROR]",YSDATA(2)=DA_"^duplicate" Q ;-->out
30 L +^YTT(601.71):30
31 S DA=$$NEW^YTQLIB(601.71)
32 S ^YTT(601.71,DA,0)=YSCODE
33 S DIK="^YTT(601.71,"
34 D IX1^DIK
35 L -^YTT(601.71)
36 S YSDATA(1)="[DATA]",YSDATA(2)=DA_"^added"
37 Q
38ADDCH(YSDATA,YS) ; check, report, force add a choice
39 N YSFORCE,YSTXT,YSIEN,DIK,DA,X,YSLEG
40 S YSFORCE=$G(YS("FORCE"),"N")
41 S YSTXT=$G(YS("TEXT"))
42 S YSLEG=$G(YS("LEGACY"))
43 I YSTXT="" S YSDATA(1)="[ERROR]",YSDATA(2)="no choice text" Q ;-->out
44 I $D(^YTT(601.75,"C",YSTXT)) S YSIEN=$O(^YTT(601.75,"C",YSTXT,0)) S YSDATA(1)="[DATA]",YSDATA(2)=YSIEN_"^existed",YSDATA(3)=YSTXT Q ;--> out
45 S X=YSTXT X ^DD("FUNC",13,1)
46 I (YSFORCE'?1"Y".E)&($D(^YTT(601.75,"AU",X))) S YSIEN=$O(^YTT(601.75,"AU",X,0)),YSDATA(1)="[DATA]",YSDATA(2)=YSIEN_"^question force",YSDATA(3)=^YTT(601.75,YSIEN,1) Q ;-->out
47 S DA=$$NEW^YTQLIB(601.75)
48 L +^YTT(601.75,DA):30
49 S ^YTT(601.75,DA,0)=DA,^YTT(601.75,DA,1)=YSTXT,$P(^YTT(601.75,DA,0),U,2)=YSLEG
50 S DIK="^YTT(601.75," D IX1^DIK
51 L -^YTT(601.75,DA)
52 S YSDATA(1)="[DATA]",YSDATA(2)=DA_"^added",YSDATA(3)=YSTXT
53 Q
54CTADD(YSDATA,YS) ;add new choicetype
55 ;input: list of choice iens in numbered sequence ex YS(1)=3,YS(2)=22
56 ;output NEW choice type number
57 N YSI,YSERR,DA,YSFOUND,YSCTDA,YSCTX,I
58 S YSERR=0 F YSI=1:1 Q:'$D(YS(YSI)) S:'$D(^YTT(601.75,YS(YSI),0)) YSERR=YSI_";"_$G(YS(YSI))
59 I YSI=1 S YSDATA(1)="[ERROR]",YSDATA(2)="no choice list" Q ;-->out
60 I YSERR'=0 S YSDATA(1)="[ERROR]",YSDATA(2)="bad choice in list/"_YSERR Q ;-->out
61 S YSDATA(1)="[DATA]",YSFOUND=0
62 L +^YTT(601.751):30
63 S YSCT=$O(^YTT(601.751,"B",""),-1)
64 S YSCT=YSCT+1
65 F YSI=1:1 Q:'$D(YS(YSI)) D
66 . S DA=$$NEW^YTQLIB(601.751)
67 . S ^YTT(601.751,DA,0)=YSCT_U_YSI_U_YS(YSI)
68 . S DIK="^YTT(601.751,"
69 . D IX1^DIK
70 L -^YTT(601.751)
71 S YSDATA(2)=YSCT_"^added"
72 Q
73CKEX ;check for existing choiceType
74 S YSCTDA=0
75 F Q:YSFOUND>0 S YSCTDA=$O(^YTT(601.751,"ACT",YS(1),YSCTDA)) Q:YSCTDA'>0 S YSCTX=$P(^YTT(601.751,YSCTDA,0),U) D
76 . S YSFOUND=0 F I=1:1 Q:'$D(YS(I)) S YSFOUND=$S($D(^YTT(601.751,"AC",YSCTX,I,YS(I))):YSFOUND+1,1:-999)
77 S:YSFOUND>1 YSFOUND=YSCTX
78 Q
79CTDEL(YSDATA,YS) ;delete a choicetype
80 ;Input: CHOICETYPE
81 ;output: DELETED if sucessful
82 ; LIST OF question iens if in use
83 N YSCT,DA,DIK,N
84 S YSCT=$G(YS("CHOICETYPE"),0)
85 I '$D(^YTT(601.751,"B",YSCT)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad ct" Q ;-->out
86 I $D(^YTT(601.72,"ACT",YSCT)) D S YSDATA(1)="[ERROR]" Q ;--> out
87 . S N=1,YSQ=0 F S YSQ=$O(^YTT(601.72,"ACT",YSCT,YSQ)) Q:YSQ'>0 S N=N+1,YSDATA(N)=YSQ
88 S DA=0,DIK="^YTT(601.751,"
89 F S DA=$O(^YTT(601.751,"B",YSCT,DA)) Q:DA'>0 D ^DIK
90 S YSDATA(1)="[DATA]",YSDATA(2)=YSCT_" deleted"
91 Q
92CHFIND(YSDATA,YS) ;find a choice in choicetypes
93 ;input CHOICE AS ien of 601.75
94 ;output: list of CHOCIETYPE iens
95 N YSCT,YSCH,N
96 S YSCH=$G(YS("CHOICE"),0)
97 I '$D(^YTT(601.75,YSCH,0)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad choice IEN" Q ;-->out
98 S YSDATA(1)="[DATA]",YSDATA(2)="none found",YSCT=0,N=1
99 F S YSCT=$O(^YTT(601.751,"ACT",YSCH,YSCT)) Q:YSCT'>0 S N=N+1,YSDATA(N)=YSCT
100 Q
101CTDESC(YSDATA,YS) ;describe choicetype
102 ;input; CHOICETYPE
103 ;output: CHOICETYPE^choicetype ien^sequence^choice ien^choice text
104 N YSCTN,YSCT,YSCH,N,YSQ,G
105 S YSCT=$G(YS("CHOICETYPE"),0)
106 I '$D(^YTT(601.751,"B",YSCT)) S YSDATA(1)="[ERROR]",YSDATA(2)="bad ct ien" Q ;-->out
107 S YSCTN=0,N=1,YSDATA(1)="[DATA]"
108 F S YSCTN=$O(^YTT(601.751,"B",YSCT,YSCTN)) Q:YSCTN'>0 D
109 . S G=$G(^YTT(601.751,YSCTN,0))
110 . S YSQ=$P(G,U,2),YSCH=$P(G,U,3)
111 . S N=N+1,YSDATA(N)=YSCT_U_YSCTN_U_YSQ_U_YSCH_U
112 . I YSCH?1N.N S YSDATA(N)=YSDATA(N)_$G(^YTT(601.75,YSCH,1))
113 Q
114ORPHCT(YSDATA) ;find and delete orphan choiceTypes
115 ;INPUT: none
116 ;OUTPUT: list of choicetypes deleted
117 N N,YSCT,YSDA,DA
118 L ^YTT(601.751):30
119 S YSCT=0,N=1,DIK="^YTT(601.751,",YSDATA(1)="[DATA]",YSDATA(2)="none"
120 F S YSCT=$O(^YTT(601.751,"B",YSCT)) Q:YSCT'>0 I '$D(^YTT(601.72,"ACT",YSCT)) D
121 . S YSDA=0 F S YSDA=$O(^YTT(601.751,"B",YSCT,YSDA)) Q:YSDA'>0 S N=N+1,YSDATA(N)=YSCT_U_YSDA,DA=YSDA D ^DIK
122 L -^YTT(601.751)
123 Q
124ORPHCH(YSDATA) ;find and delete orphan choices
125 ;INPUT none
126 ;OUTPUT list of choices deleted
127 N N,YSCH,YSDA,DA
128 L ^YTT(601.75):30
129 S YSCH=0,N=1,YSDATA="[DATA]",YSDATA(2)="none",DIK="^YTT(601.75,"
130 F S YSCH=$O(^YTT(601.75,YSCH)) Q:YSCH'>0 I '$D(^YTT(601.751,"ACT",YSCH)) D
131 . S N=N+1,YSDATA(N)=YSCH,DA=YSCH D ^DIK
132 L -^YTT(601.75)
133 Q
Note: See TracBrowser for help on using the repository browser.