1 | GMTSP87I ; SLC/AGP - Post Install GMTS*2.7*87 ; 07/10/2007
|
---|
2 | ;;2.7;Health Summary;**87**;Oct 20, 1995;Build 23
|
---|
3 | Q
|
---|
4 | ;
|
---|
5 | CONVTYPE() ;
|
---|
6 | N IEN,NAME,NEWNAME,TYPEFD
|
---|
7 | S NAME=1
|
---|
8 | F NAME="BRADEN SCALE 30D","PRESSURE ULCER","PU INTERVENTIONS" D
|
---|
9 | .I '$D(^GMT(142,"B",NAME)) S NAME=0
|
---|
10 | I NAME=0 Q 0
|
---|
11 | F NAME="BRADEN SCALE 30D","PRESSURE ULCER","PU INTERVENTIONS" D
|
---|
12 | .S NEWNAME="VA-"_NAME
|
---|
13 | .D RENAME(142,NAME,NEWNAME)
|
---|
14 | Q 1
|
---|
15 | ;
|
---|
16 | CONVOBJ ;
|
---|
17 | N IEN,NAME,NEWNAME,ONAME,TYPEFD
|
---|
18 | F NAME="BRADEN SCALE 30D (TIU)","PRESSURE ULCER","OB PU INTERVENTIONS" D
|
---|
19 | .I '$D(^GMT(142.5,"B",NAME)) Q
|
---|
20 | .S ONAME=NAME
|
---|
21 | .I NAME="OB PU INTERVENTIONS" S NAME="PU INTERVENTIONS"
|
---|
22 | .I NAME'["(TIU)" S NAME=NAME_" (TIU)"
|
---|
23 | .S NEWNAME="VA-"_NAME
|
---|
24 | .D RENAME(142.5,ONAME,NEWNAME)
|
---|
25 | Q
|
---|
26 | ;
|
---|
27 | EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
|
---|
28 | N CNT
|
---|
29 | S CNT=0
|
---|
30 | S CNT=CNT+1,ARRAY(CNT,1)="GMTS SKIN RISK HS TYPES"
|
---|
31 | I MODE["I" S ARRAY(CNT,2)="07/09/2007@13:20:09"
|
---|
32 | I MODE["A" S ARRAY(CNT,3)="O"
|
---|
33 | S CNT=CNT+1,ARRAY(CNT,1)="GMTS SKIN RISK HS OBJECTS"
|
---|
34 | I MODE["I" S ARRAY(CNT,2)="07/09/2007@13:21:13"
|
---|
35 | I MODE["A" S ARRAY(CNT,3)="O"
|
---|
36 | Q
|
---|
37 | ;
|
---|
38 | INSSTUB ;
|
---|
39 | N DA,DIE,DR,IEN,LIEN,NAME,INSBRAD,INSPU,INSPI
|
---|
40 | ;S DIK="^GMT(142,",DA=5000016 D ^DIK
|
---|
41 | ;S DIK="^GMT(142,",DA=5000017 D ^DIK
|
---|
42 | ;
|
---|
43 | S DIE="^GMT(142,"
|
---|
44 | S INSBRAD=0,INSPU=0,INSPI=0
|
---|
45 | S IEN="" F S IEN=$O(^GMT(142,IEN)) D Q:IEN'>0!(IEN=5000001)
|
---|
46 | .I IEN<5000000 S LIEN=IEN
|
---|
47 | I LIEN<5000000 D
|
---|
48 | .S DA=LIEN
|
---|
49 | .F D Q:DA=5000000!((INSBRAD=1)&(INSPU=1)&(INSPI=1))
|
---|
50 | ..S DA=DA+1
|
---|
51 | ..I '$D(^GMT(142,DA)) D
|
---|
52 | ...I INSBRAD=0 D Q
|
---|
53 | ....I $D(^GMT(142,"B","VA-BRADEN SCALE 30D"))>0 S INSBRAD=1 Q
|
---|
54 | ....S NAME="VA-BRADEN SCALE 30D" S DR=".01////^S X=NAME" D ^DIE
|
---|
55 | ....S INSBRAD=1
|
---|
56 | ...I INSPU=0 D Q
|
---|
57 | ....I $D(^GMT(142,"B","VA-PRESSURE ULCER"))>0 S INSPU=1 Q
|
---|
58 | ....S NAME="VA-PRESSURE ULCER" S DR=".01////^S X=NAME" D ^DIE
|
---|
59 | ....S INSPU=1
|
---|
60 | ...I INSPI=0 D Q
|
---|
61 | ....I $D(^GMT(142,"B","VA-PU INTERVENTIONS"))>0 S INSPI=1 Q
|
---|
62 | ....S NAME="VA-PU INTERVENTIONS" S DR=".01////^S X=NAME" D ^DIE
|
---|
63 | ....S INSPI=1
|
---|
64 | Q
|
---|
65 | ;
|
---|
66 | PRE ;
|
---|
67 | I $D(^GMT(142,"V","VA-BRADEN SCALE 30D"))>0,$D(^GMT(142,"B","VA-PRESSURE ULCER"))>0,$D(^GMT(142,"B","VA-PUINTERVEMTIONS"))>0 Q
|
---|
68 | N EXIST
|
---|
69 | S EXIST=$$CONVTYPE
|
---|
70 | D CONVOBJ
|
---|
71 | I EXIST=0 D INSSTUB
|
---|
72 | Q
|
---|
73 | ;
|
---|
74 | POST ;
|
---|
75 | D SMEXINS
|
---|
76 | Q
|
---|
77 | ;
|
---|
78 | RENAME(FILENUM,OLDNAME,NEWNAME) ;Rename entry OLDNAME to NEWNAME in
|
---|
79 | ;file number FILENUM
|
---|
80 | N DA,DIE,DR,NIEN
|
---|
81 | S NIEN=$$FIND1^DIC(FILENUM,"","BX",NEWNAME) I NIEN>0 Q
|
---|
82 | S DA=$$FIND1^DIC(FILENUM,"","BX",OLDNAME)
|
---|
83 | I DA=0 Q
|
---|
84 | S DIE=FILENUM
|
---|
85 | S DR=".01///^S X=NEWNAME"
|
---|
86 | D ^DIE
|
---|
87 | Q
|
---|
88 | ;
|
---|
89 | SMEXINS ;Silent mode install
|
---|
90 | N EXARRAY,IC,IEN,LUVALUE,PXRMINST,TEXT
|
---|
91 | S PXRMINST=1
|
---|
92 | D EXARRAY("IA",.EXARRAY)
|
---|
93 | S IC=0
|
---|
94 | F S IC=$O(EXARRAY(IC)) Q:'IC D
|
---|
95 | .S LUVALUE(1)=EXARRAY(IC,1),LUVALUE(2)=EXARRAY(IC,2)
|
---|
96 | .S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
|
---|
97 | .I IEN'=0 D
|
---|
98 | .. N TEXT
|
---|
99 | .. I LUVALUE(1)["PARAMETER" S TEXT="Installing entry "_LUVALUE(1)
|
---|
100 | .. E S TEXT="Installing reminder "_LUVALUE(1)
|
---|
101 | .. D BMES^XPDUTL(TEXT)
|
---|
102 | .. I $$PATCH^XPDUTL("PXRM*2.0*6") D
|
---|
103 | ... S ACTION=EXARRAY(IC,3)
|
---|
104 | ... D INSTALL^PXRMEXSI(IEN,ACTION,1)
|
---|
105 | .. I '$$PATCH^XPDUTL("PXRM*2.0*6") D INSTALL^PXRMEXSI(IEN,1)
|
---|
106 | Q
|
---|
107 | ;
|
---|