source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDBL3.m@ 1777

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

revised back to 6/30/08 version

File size: 4.8 KB
Line 
1PXRMDBL3 ; 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
7START 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
14END Q
15 ;
16 ;Error Handler
17 ;-------------
18ERR(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 ;--------------------------------------
31EXISTS(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 ;-------------------
38HIS(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 ;-------------
62MHOK(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 ;-----------------------------------------
99UPDATE(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
Note: See TracBrowser for help on using the repository browser.