PXRMP12I ; SLC/PKR - Inits for PXRM*2.0*12. ;08/03/2009
;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
Q
;===============================================================
BRGXREF ;Build the new RG cross-reference for file 801.41
N ERRMSG,OUTPUT,RESULT,XRARRAY
I $D(^PXRMD(801.41,"RG")) D
.D DELIXN^DDMOD(801.41,"RG","K","OUTPUT","ERRMSG")
.I $D(ERRMSG) D
..D EN^DDIOL("Error deleting 'RG' Cross-reference.")
..D AWRITE^PXRMUTIL("ERRMSG")
;Set xref specification for a new style regular xref
S XRARRAY("FILE")=801.41,XRARRAY("ROOT FILE")=801.41121
S XRARRAY("NAME")="RG",XRARRAY("USE")="LS",XRARRAY("TYPE")="REGULAR"
S XRARRAY("EXECUTION")="FIELD",XRARRAY("ACTIVITY")="IR"
S XRARRAY("VAL",1)=.01,XRARRAY("VAL",1,"SUBSCRIPT")=1
;S XRARRAY("SET CONDITION")="S X=1"
;S XRARRAY("KILL CONDITION")="S X=1"
;S XRARRAY("SET")="S ^PXRMD(801.41,""RG"",X,DA(1),DA)="""""
;S XRARRAY("KILL")="K ^PXRMD(801.41,""RG"",X,DA(1),DA)"
;S XRARRAY("WHOLE KILL")="K ^PXRMD(801.41,""RG"")"
;set description text
S XRARRAY("SHORT DESCR")="Whole-file regular 'RG' index"
S XRARRAY("DESCR",1)="This RG cross-reference is created when a result group is assigned "
S XRARRAY("DESCR",2)="to a parent element. It is killed when a result group is deleted "
S XRARRAY("DESCR",3)="from a parent element. This cross-reference is used to determine "
S XRARRAY("DESCR",4)="if a result group is used by a parent element for reporting "
S XRARRAY("DESCR",5)="purposes. If a result group is included in this cross-reference then "
S XRARRAY("DESCR",6)="it is assigned to a parent element and accordingly the result group "
S XRARRAY("DESCR",7)="cannot be deleted."
;
D CREIXN^DDMOD(.XRARRAY,"S",.RESULT,"OUTPUT","ERRMSG")
I +RESULT>0 D EN^DDIOL("Cross-reference 'RG' created.")
I RESULT="" D
.D EN^DDIOL("Error while building 'RG' cross-reference on file 801.41")
.I $D(ERRMSG) D AWRITE^PXRMUTIL("ERRMSG")
Q
;
;===============================================================
CFINC(Y) ;List of computed findings to include in the build.
N CFLIST,CFNAME
S CFLIST("VA-ADMISSIONS FOR A DATE RANGE")=""
S CFLIST("VA-BMI")=""
S CFLIST("VA-BSA")=""
S CFLIST("VA-COMBAT VET ELIGIBILITY")=""
S CFLIST("VA-CURRENT INPATIENTS")=""
S CFLIST("VA-DATE FOR AGE")=""
S CFLIST("VA-DISCHARGES FOR A DATE RANGE")=""
S CFLIST("VA-EMPLOYEE")=""
S CFLIST("VA-IS INPATIENT")=""
S CFLIST("VA-PROGRESS NOTE")=""
S CFNAME=$P(^PXRMD(811.4,Y,0),U,1)
Q $S($D(CFLIST(CFNAME)):1,1:0)
;
;===============================================================
DELDD ;Delete the old data dictionaries.
N DIU,TEXT
D EN^DDIOL("Removing old data dictionaries.")
S DIU(0)=""
F DIU=801.41,810.1,810.2,810.4,810.5,810.7,810.8,810.9,811.2,811.4,811.5,811.6,811.8,811.9 D
. S TEXT=" Deleting data dictionary for file # "_DIU
. D EN^DDIOL(TEXT)
. D EN^DIU2
Q
;
;===============================================================
EXINI ;Inits for the Exchange File.
;Delete the EXCHANGE TYPE field from file #811.8; it is no longer
;needed. Delete the 120 node so it will be rebuilt in the new format.
N DA,DIK,DPACKED,IEN,NAME
;Delete entry with misspelled name.
S NAME="VA-TBI/POLY IDT EVAULATIONS ELEMENT UPDATE"
S DPACKED=""
F S DPACKED=$O(^PXD(811.8,"B",NAME,DPACKED)) Q:DPACKED="" D
. S DA=$O(^PXD(811.8,"B",NAME,DPACKED,""))
. W !,"DA FOR DELETION IS ",DA
. D DELETE^PXRMEXFI(811.8,DA)
S IEN=0
F S IEN=+$O(^PXD(811.8,IEN)) Q:IEN=0 D
. K ^PXD(811.8,IEN,115)
. K ^PXD(811.8,IEN,120)
I '$D(^DD(811.8,115)) Q
K DA
S DIK="^DD(811.8,",DA=115,DA(1)=811.8
D ^DIK
Q
;
;===============================================================
GTDISDLG ;
N CNT,DIEN,DISTXT,FLDTYP,PXRMXTMP
D FIELD^DID(801.41,3,"","TYPE","FLDTYP","")
;Prevent re-run if after first install
I FLDTYP("TYPE")="SET" Q
S PXRMXTMP="PXRM PATCH 12"
K ^XTMP(PXRMXTMP)
S ^XTMP(PXRMXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRM PATCH 12 CONVERSION"
S DIEN=0,CNT=0 F S DIEN=$O(^PXRMD(801.41,DIEN)) Q:DIEN'>0 D
.S DISTXT=$P($G(^PXRMD(801.41,DIEN,0)),U,3)
.I DISTXT="" Q
.S CNT=CNT+1,^XTMP(PXRMXTMP,"DISABLE",CNT)=DIEN_U_DISTXT
.S $P(^PXRMD(801.41,DIEN,0),U,3)=""
Q
;
;==========================================
INILT ;Initialize list templates
N IEN,IND,LIST,TEMP0
D LTL^PXRMP12I(.LIST)
S IND=0
;IA #4123
F S IND=$O(LIST(IND)) Q:IND="" D
. S IEN=$O(^SD(409.61,"B",LIST(IND),"")) Q:IEN=""
. S TEMP0=$G(^SD(409.61,IEN,0))
. K ^SD(409.61,IEN)
. S ^SD(409.61,IEN,0)=TEMP0
Q
;
;==========================================
LLFIX ;Fix any bad nodes in location lists.
N IEN,IND,JND,NONE
D MES^XPDUTL("Fixing bad Location List nodes.")
S IEN=0,NONE=1
F S IEN=+$O(^PXRMD(810.9,IEN)) Q:IEN=0 D
. I '$D(^PXRMD(810.9,IEN,40.7,IEN)) Q
. S IND=0
. F S IND=+$O(^PXRMD(810.9,IEN,40.7,IEN,IND)) Q:IND=0 D
.. S JND=0
.. F S JND=+$O(^PXRMD(810.9,IEN,40.7,IEN,IND,JND)) Q:JND=0 D
... I $G(^PXRMD(810.9,IEN,40.7,IEN,IND,JND,0))="^" D
... K ^PXRMD(810.9,IEN,40.7,IEN,IND,JND,0)
... D MES^XPDUTL("Fixed node "_IEN_",40.7,"_IEN_","_IND_","_JND)
... S NONE=0
I NONE D MES^XPDUTL("No bad nodes were found.")
Q
;
;==========================================
LTL(LIST) ;This is the list of list templates that being distributed
;in the patch.
S LIST(1)="PXRM EX LIST COMPONENTS"
S LIST(2)="PXRM EX REMINDER EXCHANGE"
Q
;
;===============================================================
PRE ;Pre-init
;Disable options and protocols
D OPTION^PXRMUTIL("DISABLE")
D PROTOCOL^PXRMUTIL("DISABLE")
I '$$PATCH^XPDUTL("PXRM*2.0*12") D GTDISDLG
D DELEXE^PXRMEXSI("EXARRAY","PXRMP12E")
D INILT^PXRMP12I
D DELDD^PXRMP12I
Q
;
;===============================================================
POST ;Post-init
D EXINI^PXRMP12I
D RENGECHF^PXRMP12I
D STDISDLG^PXRMP12I
D UPDPARF^PXRMP12I
D UPDRTMP^PXRMP12I
D LLFIX^PXRMP12I
D RTAXEXP^PXRMP12I
;Enable options and protocols
D OPTION^PXRMUTIL("ENABLE")
D PROTOCOL^PXRMUTIL("ENABLE")
;Install Exchange File entries.
D SMEXINS^PXRMEXSI("EXARRAY","PXRMP12E")
;Make double sure any newly install taxonomies are expanded.
D RTAXEXP^PXRMP12I
;Build new RG cross-reference entry for file 801.41
D BRGXREF^PXRMP12I
Q
;
;===============================================================
RENGECHF ;Correct a typo in the name of a GEC health factor.
N DA,DIE,DR
S DA=$O(^AUTTHF("B","GEC RECENT CHANGE IN IADL RX-NO",""))
I DA="" Q
S DIE="^AUTTHF(",DR=".01////GEC RECENT CHANGE IN IADL FX-NO"
D ^DIE
Q
;
;===============================================================
RTAXEXP ;Rebuild taxonomy expansions.
;Make sure the 0 node is properly defined.
S ^PXD(811.3,0)="EXPANDED TAXONOMIES^811.3OP^1^1"
D EXPALL^PXRMBXTL
Q
;
;===============================================================
STDISDLG ;
N CNT,DIEN,DISTXT,FDA,MSG,NODE,PXRMXTMP
S PXRMXTMP="PXRM PATCH 12"
K ^TMP($J,"PXRM DISABLE REASON")
I '$D(^XTMP(PXRMXTMP)) Q
S CNT=0 F S CNT=$O(^XTMP(PXRMXTMP,"DISABLE",CNT)) Q:CNT'>0 D
.S NODE=$G(^XTMP(PXRMXTMP,"DISABLE",CNT))
.S DIEN=$P(NODE,U),DISTXT=$P(NODE,U,2)
.S $P(^PXRMD(801.41,DIEN,0),U,3)=1
.S ^TMP($J,"PXRM DISABLE REASON",1,0)=DISTXT
.S FDA(801.44,"+2,"_DIEN_",",.01)=DT
.S FDA(801.44,"+2,"_DIEN_",",1)=DUZ
.S FDA(801.44,"+2,"_DIEN_",",2)="^TMP($J,""PXRM DISABLE REASON"")"
.D UPDATE^DIE("","FDA","","MSG")
.I $D(MSG) D AWRITE^PXRMUTIL("MSG")
K ^TMP($J,"PXRM DISABLE REASON")
K ^XTMP(PXRMXTMP)
Q
;
;===============================================================
UPDPARF ;
N DA,DIE,DR
S DIE="^PXRM(800,",DA=1,DR="5////2.0P12"
D ^DIE
Q
;
;===============================================================
UPDRTMP ;
N DA,DIE,DR
S DIE="^PXRMPT(810.1,",DR="1.8////0"
S DA=0 F S DA=$O(^PXRMPT(810.1,DA)) Q:DA'>0 D
.I +$P($G(^PXRMPT(810.1,DA,0)),U,10)=1 Q
.D ^DIE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMP12I 7972 printed Oct 16, 2024@17:47:55 Page 2
PXRMP12I ; SLC/PKR - Inits for PXRM*2.0*12. ;08/03/2009
+1 ;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
+2 QUIT
+3 ;===============================================================
BRGXREF ;Build the new RG cross-reference for file 801.41
+1 NEW ERRMSG,OUTPUT,RESULT,XRARRAY
+2 IF $DATA(^PXRMD(801.41,"RG"))
Begin DoDot:1
+3 DO DELIXN^DDMOD(801.41,"RG","K","OUTPUT","ERRMSG")
+4 IF $DATA(ERRMSG)
Begin DoDot:2
+5 DO EN^DDIOL("Error deleting 'RG' Cross-reference.")
+6 DO AWRITE^PXRMUTIL("ERRMSG")
End DoDot:2
End DoDot:1
+7 ;Set xref specification for a new style regular xref
+8 SET XRARRAY("FILE")=801.41
SET XRARRAY("ROOT FILE")=801.41121
+9 SET XRARRAY("NAME")="RG"
SET XRARRAY("USE")="LS"
SET XRARRAY("TYPE")="REGULAR"
+10 SET XRARRAY("EXECUTION")="FIELD"
SET XRARRAY("ACTIVITY")="IR"
+11 SET XRARRAY("VAL",1)=.01
SET XRARRAY("VAL",1,"SUBSCRIPT")=1
+12 ;S XRARRAY("SET CONDITION")="S X=1"
+13 ;S XRARRAY("KILL CONDITION")="S X=1"
+14 ;S XRARRAY("SET")="S ^PXRMD(801.41,""RG"",X,DA(1),DA)="""""
+15 ;S XRARRAY("KILL")="K ^PXRMD(801.41,""RG"",X,DA(1),DA)"
+16 ;S XRARRAY("WHOLE KILL")="K ^PXRMD(801.41,""RG"")"
+17 ;set description text
+18 SET XRARRAY("SHORT DESCR")="Whole-file regular 'RG' index"
+19 SET XRARRAY("DESCR",1)="This RG cross-reference is created when a result group is assigned "
+20 SET XRARRAY("DESCR",2)="to a parent element. It is killed when a result group is deleted "
+21 SET XRARRAY("DESCR",3)="from a parent element. This cross-reference is used to determine "
+22 SET XRARRAY("DESCR",4)="if a result group is used by a parent element for reporting "
+23 SET XRARRAY("DESCR",5)="purposes. If a result group is included in this cross-reference then "
+24 SET XRARRAY("DESCR",6)="it is assigned to a parent element and accordingly the result group "
+25 SET XRARRAY("DESCR",7)="cannot be deleted."
+26 ;
+27 DO CREIXN^DDMOD(.XRARRAY,"S",.RESULT,"OUTPUT","ERRMSG")
+28 IF +RESULT>0
DO EN^DDIOL("Cross-reference 'RG' created.")
+29 IF RESULT=""
Begin DoDot:1
+30 DO EN^DDIOL("Error while building 'RG' cross-reference on file 801.41")
+31 IF $DATA(ERRMSG)
DO AWRITE^PXRMUTIL("ERRMSG")
End DoDot:1
+32 QUIT
+33 ;
+34 ;===============================================================
CFINC(Y) ;List of computed findings to include in the build.
+1 NEW CFLIST,CFNAME
+2 SET CFLIST("VA-ADMISSIONS FOR A DATE RANGE")=""
+3 SET CFLIST("VA-BMI")=""
+4 SET CFLIST("VA-BSA")=""
+5 SET CFLIST("VA-COMBAT VET ELIGIBILITY")=""
+6 SET CFLIST("VA-CURRENT INPATIENTS")=""
+7 SET CFLIST("VA-DATE FOR AGE")=""
+8 SET CFLIST("VA-DISCHARGES FOR A DATE RANGE")=""
+9 SET CFLIST("VA-EMPLOYEE")=""
+10 SET CFLIST("VA-IS INPATIENT")=""
+11 SET CFLIST("VA-PROGRESS NOTE")=""
+12 SET CFNAME=$PIECE(^PXRMD(811.4,Y,0),U,1)
+13 QUIT $SELECT($DATA(CFLIST(CFNAME)):1,1:0)
+14 ;
+15 ;===============================================================
DELDD ;Delete the old data dictionaries.
+1 NEW DIU,TEXT
+2 DO EN^DDIOL("Removing old data dictionaries.")
+3 SET DIU(0)=""
+4 FOR DIU=801.41,810.1,810.2,810.4,810.5,810.7,810.8,810.9,811.2,811.4,811.5,811.6,811.8,811.9
Begin DoDot:1
+5 SET TEXT=" Deleting data dictionary for file # "_DIU
+6 DO EN^DDIOL(TEXT)
+7 DO EN^DIU2
End DoDot:1
+8 QUIT
+9 ;
+10 ;===============================================================
EXINI ;Inits for the Exchange File.
+1 ;Delete the EXCHANGE TYPE field from file #811.8; it is no longer
+2 ;needed. Delete the 120 node so it will be rebuilt in the new format.
+3 NEW DA,DIK,DPACKED,IEN,NAME
+4 ;Delete entry with misspelled name.
+5 SET NAME="VA-TBI/POLY IDT EVAULATIONS ELEMENT UPDATE"
+6 SET DPACKED=""
+7 FOR
SET DPACKED=$ORDER(^PXD(811.8,"B",NAME,DPACKED))
if DPACKED=""
QUIT
Begin DoDot:1
+8 SET DA=$ORDER(^PXD(811.8,"B",NAME,DPACKED,""))
+9 WRITE !,"DA FOR DELETION IS ",DA
+10 DO DELETE^PXRMEXFI(811.8,DA)
End DoDot:1
+11 SET IEN=0
+12 FOR
SET IEN=+$ORDER(^PXD(811.8,IEN))
if IEN=0
QUIT
Begin DoDot:1
+13 KILL ^PXD(811.8,IEN,115)
+14 KILL ^PXD(811.8,IEN,120)
End DoDot:1
+15 IF '$DATA(^DD(811.8,115))
QUIT
+16 KILL DA
+17 SET DIK="^DD(811.8,"
SET DA=115
SET DA(1)=811.8
+18 DO ^DIK
+19 QUIT
+20 ;
+21 ;===============================================================
GTDISDLG ;
+1 NEW CNT,DIEN,DISTXT,FLDTYP,PXRMXTMP
+2 DO FIELD^DID(801.41,3,"","TYPE","FLDTYP","")
+3 ;Prevent re-run if after first install
+4 IF FLDTYP("TYPE")="SET"
QUIT
+5 SET PXRMXTMP="PXRM PATCH 12"
+6 KILL ^XTMP(PXRMXTMP)
+7 SET ^XTMP(PXRMXTMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"PXRM PATCH 12 CONVERSION"
+8 SET DIEN=0
SET CNT=0
FOR
SET DIEN=$ORDER(^PXRMD(801.41,DIEN))
if DIEN'>0
QUIT
Begin DoDot:1
+9 SET DISTXT=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,3)
+10 IF DISTXT=""
QUIT
+11 SET CNT=CNT+1
SET ^XTMP(PXRMXTMP,"DISABLE",CNT)=DIEN_U_DISTXT
+12 SET $PIECE(^PXRMD(801.41,DIEN,0),U,3)=""
End DoDot:1
+13 QUIT
+14 ;
+15 ;==========================================
INILT ;Initialize list templates
+1 NEW IEN,IND,LIST,TEMP0
+2 DO LTL^PXRMP12I(.LIST)
+3 SET IND=0
+4 ;IA #4123
+5 FOR
SET IND=$ORDER(LIST(IND))
if IND=""
QUIT
Begin DoDot:1
+6 SET IEN=$ORDER(^SD(409.61,"B",LIST(IND),""))
if IEN=""
QUIT
+7 SET TEMP0=$GET(^SD(409.61,IEN,0))
+8 KILL ^SD(409.61,IEN)
+9 SET ^SD(409.61,IEN,0)=TEMP0
End DoDot:1
+10 QUIT
+11 ;
+12 ;==========================================
LLFIX ;Fix any bad nodes in location lists.
+1 NEW IEN,IND,JND,NONE
+2 DO MES^XPDUTL("Fixing bad Location List nodes.")
+3 SET IEN=0
SET NONE=1
+4 FOR
SET IEN=+$ORDER(^PXRMD(810.9,IEN))
if IEN=0
QUIT
Begin DoDot:1
+5 IF '$DATA(^PXRMD(810.9,IEN,40.7,IEN))
QUIT
+6 SET IND=0
+7 FOR
SET IND=+$ORDER(^PXRMD(810.9,IEN,40.7,IEN,IND))
if IND=0
QUIT
Begin DoDot:2
+8 SET JND=0
+9 FOR
SET JND=+$ORDER(^PXRMD(810.9,IEN,40.7,IEN,IND,JND))
if JND=0
QUIT
Begin DoDot:3
+10 IF $GET(^PXRMD(810.9,IEN,40.7,IEN,IND,JND,0))="^"
Begin DoDot:4
End DoDot:4
+11 KILL ^PXRMD(810.9,IEN,40.7,IEN,IND,JND,0)
+12 DO MES^XPDUTL("Fixed node "_IEN_",40.7,"_IEN_","_IND_","_JND)
+13 SET NONE=0
End DoDot:3
End DoDot:2
End DoDot:1
+14 IF NONE
DO MES^XPDUTL("No bad nodes were found.")
+15 QUIT
+16 ;
+17 ;==========================================
LTL(LIST) ;This is the list of list templates that being distributed
+1 ;in the patch.
+2 SET LIST(1)="PXRM EX LIST COMPONENTS"
+3 SET LIST(2)="PXRM EX REMINDER EXCHANGE"
+4 QUIT
+5 ;
+6 ;===============================================================
PRE ;Pre-init
+1 ;Disable options and protocols
+2 DO OPTION^PXRMUTIL("DISABLE")
+3 DO PROTOCOL^PXRMUTIL("DISABLE")
+4 IF '$$PATCH^XPDUTL("PXRM*2.0*12")
DO GTDISDLG
+5 DO DELEXE^PXRMEXSI("EXARRAY","PXRMP12E")
+6 DO INILT^PXRMP12I
+7 DO DELDD^PXRMP12I
+8 QUIT
+9 ;
+10 ;===============================================================
POST ;Post-init
+1 DO EXINI^PXRMP12I
+2 DO RENGECHF^PXRMP12I
+3 DO STDISDLG^PXRMP12I
+4 DO UPDPARF^PXRMP12I
+5 DO UPDRTMP^PXRMP12I
+6 DO LLFIX^PXRMP12I
+7 DO RTAXEXP^PXRMP12I
+8 ;Enable options and protocols
+9 DO OPTION^PXRMUTIL("ENABLE")
+10 DO PROTOCOL^PXRMUTIL("ENABLE")
+11 ;Install Exchange File entries.
+12 DO SMEXINS^PXRMEXSI("EXARRAY","PXRMP12E")
+13 ;Make double sure any newly install taxonomies are expanded.
+14 DO RTAXEXP^PXRMP12I
+15 ;Build new RG cross-reference entry for file 801.41
+16 DO BRGXREF^PXRMP12I
+17 QUIT
+18 ;
+19 ;===============================================================
RENGECHF ;Correct a typo in the name of a GEC health factor.
+1 NEW DA,DIE,DR
+2 SET DA=$ORDER(^AUTTHF("B","GEC RECENT CHANGE IN IADL RX-NO",""))
+3 IF DA=""
QUIT
+4 SET DIE="^AUTTHF("
SET DR=".01////GEC RECENT CHANGE IN IADL FX-NO"
+5 DO ^DIE
+6 QUIT
+7 ;
+8 ;===============================================================
RTAXEXP ;Rebuild taxonomy expansions.
+1 ;Make sure the 0 node is properly defined.
+2 SET ^PXD(811.3,0)="EXPANDED TAXONOMIES^811.3OP^1^1"
+3 DO EXPALL^PXRMBXTL
+4 QUIT
+5 ;
+6 ;===============================================================
STDISDLG ;
+1 NEW CNT,DIEN,DISTXT,FDA,MSG,NODE,PXRMXTMP
+2 SET PXRMXTMP="PXRM PATCH 12"
+3 KILL ^TMP($JOB,"PXRM DISABLE REASON")
+4 IF '$DATA(^XTMP(PXRMXTMP))
QUIT
+5 SET CNT=0
FOR
SET CNT=$ORDER(^XTMP(PXRMXTMP,"DISABLE",CNT))
if CNT'>0
QUIT
Begin DoDot:1
+6 SET NODE=$GET(^XTMP(PXRMXTMP,"DISABLE",CNT))
+7 SET DIEN=$PIECE(NODE,U)
SET DISTXT=$PIECE(NODE,U,2)
+8 SET $PIECE(^PXRMD(801.41,DIEN,0),U,3)=1
+9 SET ^TMP($JOB,"PXRM DISABLE REASON",1,0)=DISTXT
+10 SET FDA(801.44,"+2,"_DIEN_",",.01)=DT
+11 SET FDA(801.44,"+2,"_DIEN_",",1)=DUZ
+12 SET FDA(801.44,"+2,"_DIEN_",",2)="^TMP($J,""PXRM DISABLE REASON"")"
+13 DO UPDATE^DIE("","FDA","","MSG")
+14 IF $DATA(MSG)
DO AWRITE^PXRMUTIL("MSG")
End DoDot:1
+15 KILL ^TMP($JOB,"PXRM DISABLE REASON")
+16 KILL ^XTMP(PXRMXTMP)
+17 QUIT
+18 ;
+19 ;===============================================================
UPDPARF ;
+1 NEW DA,DIE,DR
+2 SET DIE="^PXRM(800,"
SET DA=1
SET DR="5////2.0P12"
+3 DO ^DIE
+4 QUIT
+5 ;
+6 ;===============================================================
UPDRTMP ;
+1 NEW DA,DIE,DR
+2 SET DIE="^PXRMPT(810.1,"
SET DR="1.8////0"
+3 SET DA=0
FOR
SET DA=$ORDER(^PXRMPT(810.1,DA))
if DA'>0
QUIT
Begin DoDot:1
+4 IF +$PIECE($GET(^PXRMPT(810.1,DA,0)),U,10)=1
QUIT
+5 DO ^DIE
End DoDot:1
+6 QUIT
+7 ;
