source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSP87I.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1GMTSP87I ; 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 ;
5CONVTYPE() ;
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 ;
16CONVOBJ ;
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 ;
27EXARRAY(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 ;
38INSSTUB ;
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 ;
66PRE ;
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 ;
74POST ;
75 D SMEXINS
76 Q
77 ;
78RENAME(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 ;
89SMEXINS ;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 ;
Note: See TracBrowser for help on using the repository browser.