source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMP10I.m@ 761

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1PXRMP10I ; SLC/PKR - PXRM*2.0*10 init routine. ;09/28/2007
2 ;;2.0;CLINICAL REMINDERS;**10**;Feb 04, 2005;Build 25
3 Q
4 ;
5DELEI ;If the Exchange File entry already exists delete it.
6 N ARRAY,IC,IND,LIST,LUVALUE,NUM
7 D EXARRAY("L",.ARRAY)
8 S IC=0
9 F S IC=$O(ARRAY(IC)) Q:'IC D
10 . S LUVALUE(1)=ARRAY(IC,1)
11 . D FIND^DIC(811.8,"","","U",.LUVALUE,"","","","","LIST")
12 . I '$D(LIST) Q
13 . S NUM=$P(LIST("DILIST",0),U,1)
14 . I NUM'=0 D
15 .. F IND=1:1:NUM D
16 ... N DA,DIK
17 ... S DIK="^PXD(811.8,"
18 ... S DA=LIST("DILIST",2,IND)
19 ... D ^DIK
20 Q
21 ;==========================================
22DITEMAR(DIEN,ARRAY) ;
23 ;DIEN is the IEN of the dialog top level
24 ;Array contains the dialog elements and groups within the dialog.
25 N CNT,IEN,REPIEN,TYPE
26 S CNT=0 F S CNT=$O(^PXRMD(801.41,DIEN,10,CNT)) Q:CNT'>0 D
27 .S IEN=$P($G(^PXRMD(801.41,DIEN,10,CNT,0)),U,2) Q:IEN'>0
28 .S REPIEN=$P($G(^PXRMD(801.41,IEN,49)),U,3)
29 .I REPIEN>0 D DITEMAR(REPIEN,.ARRAY)
30 .S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
31 .I TYPE="G"!(TYPE="E") D DITEMAR(IEN,.ARRAY)
32 .I '$D(ARRAY(IEN)) S ARRAY(IEN)=""
33 I '$D(ARRAY(DIEN)) S ARRAY(DIEN)=""
34 Q
35 ;
36DMAKENAT(DA) ;
37 N CLASS,DIE,DR,IEN,NAME,NEWNAME,PREFIX,TYPE
38 S NAME=$P($G(^PXRMD(801.41,DA,0)),U)
39 I $E(NAME,1,3)="VA-"!($E(NAME,1,4)="PXRM") Q
40 S CLASS="N"
41 S DIE="^PXRMXD(801.41,"
42 S DR="100////^S X=CLASS"
43 D ^DIE
44 S TYPE=$P($G(^PXRMD(801.41,DA,0)),U,4)
45 S PREFIX=$S(TYPE="R":"VA-",TYPE="G":"VA-",TYPE="E":"VA-",1:"PXRM ")
46 S NEWNAME=PREFIX_NAME
47 D RENAME(801.41,NAME,NEWNAME)
48 Q
49 ;
50EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
51 N CNT
52 S CNT=0
53 ;
54 S CNT=CNT+1,ARRAY(CNT,1)="VA-VANOD SKIN ASSESSMENT"
55 I MODE["I" S ARRAY(CNT,2)="07/16/2007@14:45:37"
56 I MODE["A" S ARRAY(CNT,3)="O"
57 ;
58 S CNT=CNT+1,ARRAY(CNT,1)="VA-VANOD SKIN REASSESSMENT"
59 I MODE["I" S ARRAY(CNT,2)="07/16/2007@14:46:02"
60 I MODE["A" S ARRAY(CNT,3)="O"
61 ;
62 S CNT=CNT+1,ARRAY(CNT,1)="GMTS SKIN RISK HS TYPES"
63 I MODE["I" S ARRAY(CNT,2)="07/09/2007@13:20:09"
64 I MODE["A" S ARRAY(CNT,3)="O"
65 ;
66 S CNT=CNT+1,ARRAY(CNT,1)="GMTS SKIN RISK HS OBJECTS"
67 I MODE["I" S ARRAY(CNT,2)="07/09/2007@13:21:13"
68 I MODE["A" S ARRAY(CNT,3)="O"
69 Q
70 ;
71 ;==========================================
72EXFINC(Y) ;Return a 1 if the Exchange file entry is in the list to
73 ;include in the build. This is used in the build to determine which
74 ;entries to include.
75 N EXARRAY,FOUND,IEN,IC,LUVALUE
76 D EXARRAY("I",.EXARRAY)
77 S FOUND=0
78 S IC=0
79 F S IC=+$O(EXARRAY(IC)) Q:(IC=0)!(FOUND) D
80 . M LUVALUE=EXARRAY(IC)
81 . S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
82 . I IEN=Y S FOUND=1 Q
83 Q FOUND
84 ;
85NATCONV ;
86 N ARRAY,CLASS,CNT,DA,DIE,DIEN,DR,IEN,NAME,PXRMEXCH,PXRMINST,RIEN
87 S PXRMEXCH=1,PXRMINST=1,CLASS="N"
88 F NAME="VANOD SKIN ASSESSMENT","VANOD SKIN REASSESSMENT" D
89 .S RIEN=$O(^PXD(811.9,"B",NAME,"")) Q:RIEN'>0
90 .S DA=RIEN,DIE="^PXD(811.9,",DR="100///^S X=CLASS"
91 .D ^DIE
92 .D RENAME(811.9,NAME,"VA-"_NAME)
93 .S DIEN=$P($G(^PXD(811.9,RIEN,51)),U) Q:DIEN'>0
94 .D DITEMAR(DIEN,.ARRAY)
95 .S IEN=0 F S IEN=$O(ARRAY(IEN)) Q:IEN'>0 D
96 ..D DMAKENAT(IEN)
97 .D DMAKENAT(DIEN)
98 Q
99 ;
100PRE ;
101 D DELEI
102 D NATCONV
103 Q
104 ;
105POST ;
106 D SMEXINS
107 Q
108 ;
109RENAME(FILENUM,OLDNAME,NEWNAME) ;Rename entry OLDNAME to NEWNAME in
110 ;file number FILENUM.
111 N DA,DIE,DR,NIEN
112 S NIEN=$$FIND1^DIC(FILENUM,"","BX",NEWNAME) I NIEN>0 Q
113 S DA=$$FIND1^DIC(FILENUM,"","BX",OLDNAME)
114 I DA=0 Q
115 S DIE=FILENUM
116 S DR=".01///^S X=NEWNAME"
117 D ^DIE
118 Q
119 ;
120SENDDLG(IEN) ;
121 N NAME
122 S NAME=$P($G(^PXRMD(801.41,IEN,0)),U)
123 I NAME="PXRM BRADEN 6-8" Q 1
124 I NAME="PXRM BRADEN 10-12" Q 1
125 I NAME="PXRM BRADEN 13-14" Q 1
126 I NAME="PXRM BRADEN 15-18" Q 1
127 I NAME="PXRM BRADEN 19-23" Q 1
128 I NAME="PXRM VANOD PU LOCATIONS" Q 1
129 I NAME="PXRM VANOD SKIN COLOR" Q 1
130 I NAME="PXRM VANOD SKIN MOISTURE" Q 1
131 I NAME="PXRM VANOD SKIN TEMP" Q 1
132 I NAME="PXRM VANOD SKIN TURGOR" Q 1
133 I NAME="PXRM VANOD DATE FORCED TODAY" Q 1
134 Q 0
135 ;
136SMEXINS ;Silent mode install
137 N ACTION,EXARRAY,IC,IEN,LUVALUE,PXRMINST,TEXT
138 S PXRMINST=1
139 D EXARRAY("IA",.EXARRAY)
140 S IC=0
141 F S IC=$O(EXARRAY(IC)) Q:'IC D
142 .I EXARRAY(IC,1)["GMTS" Q
143 .S LUVALUE(1)=EXARRAY(IC,1),LUVALUE(IC,2)=EXARRAY(IC,2)
144 .S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
145 .I IEN'=0 D
146 .. N TEXT
147 .. I LUVALUE(1)["PARAMETER" S TEXT="Installing entry "_LUVALUE(1)
148 .. E S TEXT="Installing reminder "_LUVALUE(1)
149 .. D BMES^XPDUTL(TEXT)
150 .. I $$PATCH^XPDUTL("PXRM*2.0*6") D
151 ... S ACTION=EXARRAY(IC,3)
152 ... D INSTALL^PXRMEXSI(IEN,ACTION,1)
153 .. I '$$PATCH^XPDUTL("PXRM*2.0*6") D INSTALL^PXRMEXSI(IEN,1)
154 Q
155 ;
Note: See TracBrowser for help on using the repository browser.