Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMP12I

PXRMP12I.m

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