GMTSP87I ; SLC/AGP - Post Install GMTS*2.7*87 ; 07/10/2007
;;2.7;Health Summary;**87**;Oct 20, 1995;Build 23
Q
;
CONVTYPE() ;
N IEN,NAME,NEWNAME,TYPEFD
S NAME=1
F NAME="BRADEN SCALE 30D","PRESSURE ULCER","PU INTERVENTIONS" D
.I '$D(^GMT(142,"B",NAME)) S NAME=0
I NAME=0 Q 0
F NAME="BRADEN SCALE 30D","PRESSURE ULCER","PU INTERVENTIONS" D
.S NEWNAME="VA-"_NAME
.D RENAME(142,NAME,NEWNAME)
Q 1
;
CONVOBJ ;
N IEN,NAME,NEWNAME,ONAME,TYPEFD
F NAME="BRADEN SCALE 30D (TIU)","PRESSURE ULCER","OB PU INTERVENTIONS" D
.I '$D(^GMT(142.5,"B",NAME)) Q
.S ONAME=NAME
.I NAME="OB PU INTERVENTIONS" S NAME="PU INTERVENTIONS"
.I NAME'["(TIU)" S NAME=NAME_" (TIU)"
.S NEWNAME="VA-"_NAME
.D RENAME(142.5,ONAME,NEWNAME)
Q
;
EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
N CNT
S CNT=0
S CNT=CNT+1,ARRAY(CNT,1)="GMTS SKIN RISK HS TYPES"
I MODE["I" S ARRAY(CNT,2)="07/09/2007@13:20:09"
I MODE["A" S ARRAY(CNT,3)="O"
S CNT=CNT+1,ARRAY(CNT,1)="GMTS SKIN RISK HS OBJECTS"
I MODE["I" S ARRAY(CNT,2)="07/09/2007@13:21:13"
I MODE["A" S ARRAY(CNT,3)="O"
Q
;
INSSTUB ;
N DA,DIE,DR,IEN,LIEN,NAME,INSBRAD,INSPU,INSPI
;S DIK="^GMT(142,",DA=5000016 D ^DIK
;S DIK="^GMT(142,",DA=5000017 D ^DIK
;
S DIE="^GMT(142,"
S INSBRAD=0,INSPU=0,INSPI=0
S IEN="" F S IEN=$O(^GMT(142,IEN)) D Q:IEN'>0!(IEN=5000001)
.I IEN<5000000 S LIEN=IEN
I LIEN<5000000 D
.S DA=LIEN
.F D Q:DA=5000000!((INSBRAD=1)&(INSPU=1)&(INSPI=1))
..S DA=DA+1
..I '$D(^GMT(142,DA)) D
...I INSBRAD=0 D Q
....I $D(^GMT(142,"B","VA-BRADEN SCALE 30D"))>0 S INSBRAD=1 Q
....S NAME="VA-BRADEN SCALE 30D" S DR=".01////^S X=NAME" D ^DIE
....S INSBRAD=1
...I INSPU=0 D Q
....I $D(^GMT(142,"B","VA-PRESSURE ULCER"))>0 S INSPU=1 Q
....S NAME="VA-PRESSURE ULCER" S DR=".01////^S X=NAME" D ^DIE
....S INSPU=1
...I INSPI=0 D Q
....I $D(^GMT(142,"B","VA-PU INTERVENTIONS"))>0 S INSPI=1 Q
....S NAME="VA-PU INTERVENTIONS" S DR=".01////^S X=NAME" D ^DIE
....S INSPI=1
Q
;
PRE ;
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
N EXIST
S EXIST=$$CONVTYPE
D CONVOBJ
I EXIST=0 D INSSTUB
Q
;
POST ;
D SMEXINS
Q
;
RENAME(FILENUM,OLDNAME,NEWNAME) ;Rename entry OLDNAME to NEWNAME in
;file number FILENUM
N DA,DIE,DR,NIEN
S NIEN=$$FIND1^DIC(FILENUM,"","BX",NEWNAME) I NIEN>0 Q
S DA=$$FIND1^DIC(FILENUM,"","BX",OLDNAME)
I DA=0 Q
S DIE=FILENUM
S DR=".01///^S X=NEWNAME"
D ^DIE
Q
;
SMEXINS ;Silent mode install
N EXARRAY,IC,IEN,LUVALUE,PXRMINST,TEXT
S PXRMINST=1
D EXARRAY("IA",.EXARRAY)
S IC=0
F S IC=$O(EXARRAY(IC)) Q:'IC D
.S LUVALUE(1)=EXARRAY(IC,1),LUVALUE(2)=EXARRAY(IC,2)
.S IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
.I IEN'=0 D
.. N TEXT
.. I LUVALUE(1)["PARAMETER" S TEXT="Installing entry "_LUVALUE(1)
.. E S TEXT="Installing reminder "_LUVALUE(1)
.. D BMES^XPDUTL(TEXT)
.. I $$PATCH^XPDUTL("PXRM*2.0*6") D
... S ACTION=EXARRAY(IC,3)
... D INSTALL^PXRMEXSI(IEN,ACTION,1)
.. I '$$PATCH^XPDUTL("PXRM*2.0*6") D INSTALL^PXRMEXSI(IEN,1)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSP87I 3169 printed Nov 22, 2024@17:09:10 Page 2
GMTSP87I ; SLC/AGP - Post Install GMTS*2.7*87 ; 07/10/2007
+1 ;;2.7;Health Summary;**87**;Oct 20, 1995;Build 23
+2 QUIT
+3 ;
CONVTYPE() ;
+1 NEW IEN,NAME,NEWNAME,TYPEFD
+2 SET NAME=1
+3 FOR NAME="BRADEN SCALE 30D","PRESSURE ULCER","PU INTERVENTIONS"
Begin DoDot:1
+4 IF '$DATA(^GMT(142,"B",NAME))
SET NAME=0
End DoDot:1
+5 IF NAME=0
QUIT 0
+6 FOR NAME="BRADEN SCALE 30D","PRESSURE ULCER","PU INTERVENTIONS"
Begin DoDot:1
+7 SET NEWNAME="VA-"_NAME
+8 DO RENAME(142,NAME,NEWNAME)
End DoDot:1
+9 QUIT 1
+10 ;
CONVOBJ ;
+1 NEW IEN,NAME,NEWNAME,ONAME,TYPEFD
+2 FOR NAME="BRADEN SCALE 30D (TIU)","PRESSURE ULCER","OB PU INTERVENTIONS"
Begin DoDot:1
+3 IF '$DATA(^GMT(142.5,"B",NAME))
QUIT
+4 SET ONAME=NAME
+5 IF NAME="OB PU INTERVENTIONS"
SET NAME="PU INTERVENTIONS"
+6 IF NAME'["(TIU)"
SET NAME=NAME_" (TIU)"
+7 SET NEWNAME="VA-"_NAME
+8 DO RENAME(142.5,ONAME,NEWNAME)
End DoDot:1
+9 QUIT
+10 ;
EXARRAY(MODE,ARRAY) ;List of exchange entries used by delete and install
+1 NEW CNT
+2 SET CNT=0
+3 SET CNT=CNT+1
SET ARRAY(CNT,1)="GMTS SKIN RISK HS TYPES"
+4 IF MODE["I"
SET ARRAY(CNT,2)="07/09/2007@13:20:09"
+5 IF MODE["A"
SET ARRAY(CNT,3)="O"
+6 SET CNT=CNT+1
SET ARRAY(CNT,1)="GMTS SKIN RISK HS OBJECTS"
+7 IF MODE["I"
SET ARRAY(CNT,2)="07/09/2007@13:21:13"
+8 IF MODE["A"
SET ARRAY(CNT,3)="O"
+9 QUIT
+10 ;
INSSTUB ;
+1 NEW DA,DIE,DR,IEN,LIEN,NAME,INSBRAD,INSPU,INSPI
+2 ;S DIK="^GMT(142,",DA=5000016 D ^DIK
+3 ;S DIK="^GMT(142,",DA=5000017 D ^DIK
+4 ;
+5 SET DIE="^GMT(142,"
+6 SET INSBRAD=0
SET INSPU=0
SET INSPI=0
+7 SET IEN=""
FOR
SET IEN=$ORDER(^GMT(142,IEN))
Begin DoDot:1
+8 IF IEN<5000000
SET LIEN=IEN
End DoDot:1
if IEN'>0!(IEN=5000001)
QUIT
+9 IF LIEN<5000000
Begin DoDot:1
+10 SET DA=LIEN
+11 FOR
Begin DoDot:2
+12 SET DA=DA+1
+13 IF '$DATA(^GMT(142,DA))
Begin DoDot:3
+14 IF INSBRAD=0
Begin DoDot:4
+15 IF $DATA(^GMT(142,"B","VA-BRADEN SCALE 30D"))>0
SET INSBRAD=1
QUIT
+16 SET NAME="VA-BRADEN SCALE 30D"
SET DR=".01////^S X=NAME"
DO ^DIE
+17 SET INSBRAD=1
End DoDot:4
QUIT
+18 IF INSPU=0
Begin DoDot:4
+19 IF $DATA(^GMT(142,"B","VA-PRESSURE ULCER"))>0
SET INSPU=1
QUIT
+20 SET NAME="VA-PRESSURE ULCER"
SET DR=".01////^S X=NAME"
DO ^DIE
+21 SET INSPU=1
End DoDot:4
QUIT
+22 IF INSPI=0
Begin DoDot:4
+23 IF $DATA(^GMT(142,"B","VA-PU INTERVENTIONS"))>0
SET INSPI=1
QUIT
+24 SET NAME="VA-PU INTERVENTIONS"
SET DR=".01////^S X=NAME"
DO ^DIE
+25 SET INSPI=1
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
if DA=5000000!((INSBRAD=1)&(INSPU=1)&(INSPI=1))
QUIT
End DoDot:1
+26 QUIT
+27 ;
PRE ;
+1 IF $DATA(^GMT(142,"V","VA-BRADEN SCALE 30D"))>0
IF $DATA(^GMT(142,"B","VA-PRESSURE ULCER"))>0
IF $DATA(^GMT(142,"B","VA-PUINTERVEMTIONS"))>0
QUIT
+2 NEW EXIST
+3 SET EXIST=$$CONVTYPE
+4 DO CONVOBJ
+5 IF EXIST=0
DO INSSTUB
+6 QUIT
+7 ;
POST ;
+1 DO SMEXINS
+2 QUIT
+3 ;
RENAME(FILENUM,OLDNAME,NEWNAME) ;Rename entry OLDNAME to NEWNAME in
+1 ;file number FILENUM
+2 NEW DA,DIE,DR,NIEN
+3 SET NIEN=$$FIND1^DIC(FILENUM,"","BX",NEWNAME)
IF NIEN>0
QUIT
+4 SET DA=$$FIND1^DIC(FILENUM,"","BX",OLDNAME)
+5 IF DA=0
QUIT
+6 SET DIE=FILENUM
+7 SET DR=".01///^S X=NEWNAME"
+8 DO ^DIE
+9 QUIT
+10 ;
SMEXINS ;Silent mode install
+1 NEW EXARRAY,IC,IEN,LUVALUE,PXRMINST,TEXT
+2 SET PXRMINST=1
+3 DO EXARRAY("IA",.EXARRAY)
+4 SET IC=0
+5 FOR
SET IC=$ORDER(EXARRAY(IC))
if 'IC
QUIT
Begin DoDot:1
+6 SET LUVALUE(1)=EXARRAY(IC,1)
SET LUVALUE(2)=EXARRAY(IC,2)
+7 SET IEN=+$$FIND1^DIC(811.8,"","KU",.LUVALUE)
+8 IF IEN'=0
Begin DoDot:2
+9 NEW TEXT
+10 IF LUVALUE(1)["PARAMETER"
SET TEXT="Installing entry "_LUVALUE(1)
+11 IF '$TEST
SET TEXT="Installing reminder "_LUVALUE(1)
+12 DO BMES^XPDUTL(TEXT)
+13 IF $$PATCH^XPDUTL("PXRM*2.0*6")
Begin DoDot:3
+14 SET ACTION=EXARRAY(IC,3)
+15 DO INSTALL^PXRMEXSI(IEN,ACTION,1)
End DoDot:3
+16 IF '$$PATCH^XPDUTL("PXRM*2.0*6")
DO INSTALL^PXRMEXSI(IEN,1)
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
