1 | PXRMDBL3 ; SLC/PJH - Reminder Dialog Generation. (overflow) ;04/30/2001
|
---|
2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
---|
3 | ;
|
---|
4 | ; Called from PXRMDBL1
|
---|
5 | ;
|
---|
6 | ;Set number range for site
|
---|
7 | START D SETSTART^PXRMCOPY("^PXRMD(801.41,")
|
---|
8 | ;Update dialog file for individual dialog items
|
---|
9 | D UPDATE(.ARRAY,.WPTXT,"E")
|
---|
10 | ;Create reminder dialog
|
---|
11 | D UPDATE(.DSET,"","R")
|
---|
12 | ;
|
---|
13 | W !!,"Dialog build complete" H 3
|
---|
14 | END Q
|
---|
15 | ;
|
---|
16 | ;Error Handler
|
---|
17 | ;-------------
|
---|
18 | ERR(DESC) ;
|
---|
19 | N ERROR,IC,REF
|
---|
20 | S ERROR(1)="Unable to update dialog file : "_DESC
|
---|
21 | S ERROR(2)="Error in UPDATE^DIE, needs further investigation"
|
---|
22 | ;Move MSG into ERROR
|
---|
23 | S REF="MSG"
|
---|
24 | F IC=3:1 S REF=$Q(@REF) Q:REF="" S ERROR(IC)=REF_"="_@REF
|
---|
25 | ;Screen message
|
---|
26 | D BMES^XPDUTL(.ERROR)
|
---|
27 | Q
|
---|
28 | ;
|
---|
29 | ;Check if dialog element already exists
|
---|
30 | ;--------------------------------------
|
---|
31 | EXISTS(NAME) ;
|
---|
32 | N IEN S IEN=$O(^PXRMD(801.41,"B",NAME,""))
|
---|
33 | I IEN S DSET(1,CNT*5)=IEN Q 1
|
---|
34 | Q 0
|
---|
35 | ;
|
---|
36 | ;Update edit history
|
---|
37 | ;-------------------
|
---|
38 | HIS(IENN) ;
|
---|
39 | ;First delete any existing history entries.
|
---|
40 | N ENTRY,IND,IENS,FDA,FDAIEN,MSG,WP
|
---|
41 | S ENTRY="^PXRMD(801.41,"_IENN_",110)"
|
---|
42 | S IND=0
|
---|
43 | F S IND=$O(@ENTRY@(IND)) Q:+IND=0 D
|
---|
44 | . S IENS=IND_","_IENN_","
|
---|
45 | . S FDA(801.44,IENS,.01)="@"
|
---|
46 | I $D(FDA(801.44)) D
|
---|
47 | .D FILE^DIE("K","FDA","MSG") I $D(MSG) D AWRITE^PXRMUTIL("MSG")
|
---|
48 | ;Establish an initial entry in the edit history.
|
---|
49 | K FDA,MSG
|
---|
50 | S IENS="+1,"_IENN_","
|
---|
51 | S FDAIEN(IENN)=IENN
|
---|
52 | S FDA(801.44,IENS,.01)=$$FMTE^XLFDT($$NOW^XLFDT,"5Z")
|
---|
53 | S FDA(801.44,IENS,1)=$$GET1^DIQ(200,DUZ,.01)
|
---|
54 | S FDA(801.44,IENS,2)="WP(1,1)"
|
---|
55 | S WP(1,1,1)="Autogenerated"
|
---|
56 | D UPDATE^DIE("E","FDA","FDAIEN","MSG")
|
---|
57 | I $D(MSG) D AWRITE^PXRMUTIL("MSG")
|
---|
58 | Q
|
---|
59 | ;
|
---|
60 | ;Mental Health
|
---|
61 | ;-------------
|
---|
62 | MHOK(IEN) ;
|
---|
63 | N RNAME,TEST,YT S YT=""
|
---|
64 | ;Convert ien to name
|
---|
65 | S YT("CODE")=$P($G(^YTT(601,IEN,0)),U)
|
---|
66 | ;Quit if no code found
|
---|
67 | I YT("CODE")="" Q 0
|
---|
68 | ;Check if this is an allowable GUI test
|
---|
69 | I (YT("CODE")'="GAF"),($P($G(^YTT(601.6,IEN,0)),U,4)'="Y") Q 0
|
---|
70 | ;Get details of test
|
---|
71 | D SHOWALL^YTAPI3(.TEST,.YT)
|
---|
72 | ;Check if valid
|
---|
73 | I TEST(1)["[ERROR]" Q 0
|
---|
74 | ;
|
---|
75 | S DNAME=FTYP_" "_YT("CODE")
|
---|
76 | ;Create arrays
|
---|
77 | S CNT=CNT+1
|
---|
78 | ;Convert dialog item name to UC
|
---|
79 | S DNAME=$TR(DNAME,LOWER,UPPER)
|
---|
80 | ;Truncate the item name - without finesse
|
---|
81 | S DSHORT=DNAME
|
---|
82 | I $L(DSHORT)>40 S DSHORT=$E(DNAME,1,40)
|
---|
83 | ;Dialog item name, finding item and result
|
---|
84 | S ARRAY(CNT)=DSHORT_U_U_RESN_U
|
---|
85 | ;Result group name
|
---|
86 | S RNAME="PXRM "_YT("CODE")_" RESULT GROUP"
|
---|
87 | ;Result pointer
|
---|
88 | S $P(ARRAY(CNT),U,7)=$O(^PXRMD(801.41,"B",RNAME,""))
|
---|
89 | ;If aims exclude from p/n
|
---|
90 | I YT("CODE")="AIMS" S $P(ARRAY(CNT),U,6)=1
|
---|
91 | ;Prompt text
|
---|
92 | S WPTXT(CNT,1)=YT("CODE")_" (Mental Health Instrument)"
|
---|
93 | ;test
|
---|
94 | W !!,CNT,?5,WPTXT(CNT,1)
|
---|
95 | Q 1
|
---|
96 | ;
|
---|
97 | ;Sub-routine to update dialog file #801.41
|
---|
98 | ;-----------------------------------------
|
---|
99 | UPDATE(INP,WPTXT,DTYPE) ;
|
---|
100 | N CNT,DATA,DESC,IEN,STRING,SUB,TEXT
|
---|
101 | N FDA,FDAIEN,MSG
|
---|
102 | ;Get each dialog line in turn
|
---|
103 | S STRING="Updating "_$S(DTYPE="E":"Dialog Elements",1:"Reminder Dialog")
|
---|
104 | D BMES^XPDUTL(STRING)
|
---|
105 | ;
|
---|
106 | ;Create FDA for each entry in array
|
---|
107 | S CNT=""
|
---|
108 | F S CNT=$O(INP(CNT)) Q:CNT="" D Q:$D(MSG)
|
---|
109 | .;If finding is a finding item parameter no need to build an element
|
---|
110 | .I DTYPE="E",$P(INP(CNT),U)=801.43 D Q
|
---|
111 | ..S DSET(1,CNT)=$P(INP(CNT),U,2)
|
---|
112 | .;Build FDA array
|
---|
113 | .K FDAIEN,FDA
|
---|
114 | .;If existing element and not in replace mode don't update FDA
|
---|
115 | .I DTYPE="E",'PXRMREPL Q:$$EXISTS($P(INP(CNT),U))
|
---|
116 | .;Name
|
---|
117 | .S FDA(801.41,"?+1,",.01)=$P(INP(CNT),U)
|
---|
118 | .;Dialog type
|
---|
119 | .S FDA(801.41,"?+1,",4)=DTYPE
|
---|
120 | .;Class
|
---|
121 | .S FDA(801.41,"?+1,",100)="L"
|
---|
122 | .;Sponsor
|
---|
123 | .S FDA(801.41,"?+1,",101)=""
|
---|
124 | .;Prompt text/finding entries
|
---|
125 | .I DTYPE="E" D
|
---|
126 | ..S FDA(801.41,"?+1,",13)=$P(INP(CNT),U,2)
|
---|
127 | ..S FDA(801.41,"?+1,",15)=$P(INP(CNT),U,3)
|
---|
128 | ..S FDA(801.41,"?+1,",17)=$P(INP(CNT),U,4)
|
---|
129 | ..S FDA(801.41,"?+1,",25)="WPTXT("_CNT_")"
|
---|
130 | ..;MH fields (exclude from P/N and results pointer)
|
---|
131 | ..S:$P(INP(CNT),U,6) FDA(801.41,"?+1,",54)=$P(INP(CNT),U,6)
|
---|
132 | ..S:$P(INP(CNT),U,7) FDA(801.41,"?+1,",55)=$P(INP(CNT),U,7)
|
---|
133 | .;Reminder dialog associated reminder/DISABLE
|
---|
134 | .I DTYPE="R" D
|
---|
135 | ..S FDA(801.41,"?+1,",2)=REM
|
---|
136 | ..I PXRMENAB'="Y" S FDA(801.41,"?+1,",3)="DISABLED AT AUTO GENERATE"
|
---|
137 | .;Dialog items point to prompts and actions, Sets point to dialog items
|
---|
138 | .N ACNT,SUB
|
---|
139 | .;S ACNT=0,SUB=2
|
---|
140 | .S ACNT=0,SUB=1
|
---|
141 | .F S ACNT=$O(INP(CNT,ACNT)) Q:ACNT="" D
|
---|
142 | ..S SUB=SUB+1,FDA(801.412,"?+"_SUB_",?+1,",.01)=ACNT
|
---|
143 | ..S FDA(801.412,"?+"_SUB_",?+1,",2)=$P(INP(CNT,ACNT),U)
|
---|
144 | ..S FDA(801.412,"?+"_SUB_",?+1,",6)=$P(INP(CNT,ACNT),U,2)
|
---|
145 | ..S FDA(801.412,"?+"_SUB_",?+1,",7)=$P(INP(CNT,ACNT),U,3)
|
---|
146 | ..S FDA(801.412,"?+"_SUB_",?+1,",8)=$P(INP(CNT,ACNT),U,4)
|
---|
147 | ..S FDA(801.412,"?+"_SUB_",?+1,",9)=$P(INP(CNT,ACNT),U,5)
|
---|
148 | .;Update #801.41
|
---|
149 | .D UPDATE^DIE("","FDA","FDAIEN","MSG")
|
---|
150 | .I $D(MSG) D ERR($G(INP(CNT))) Q
|
---|
151 | .;Save IEN of dialog created/used for later use in building dialog set
|
---|
152 | .I DTYPE="E" S DSET(1,CNT*5)=FDAIEN(1)
|
---|
153 | .;Insert link to reminder
|
---|
154 | .I DTYPE="R",PXRMLINK="Y" D
|
---|
155 | ..S $P(^PXD(811.9,REM,51),U)=FDAIEN(1),^PXD(811.9,"AG",FDAIEN(1),REM)=""
|
---|
156 | .;Update Edit History
|
---|
157 | .D HIS(FDAIEN(1))
|
---|
158 | Q
|
---|