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

PXRMP47I.m

Go to the documentation of this file. 
  1. PXRMP47I ;SLC/PKR - Inits for PXRM*2.0*47. ;05/18/2016
  1.  ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
  1.  Q
  1.  ;==========================================
  1. CFINC(Y) ;List of computed findings to include in the build.
  1.  N CFLIST,CFNAME
  1.  S CFLIST("VA-AGE BIRTH SEX LIST")=""
  1.  S CFLIST("VA-BIRTH DATE BIRTH SEX LIST")=""
  1.  S CFLIST("VA-FILEMAN DATE")=""
  1.  S CFNAME=$P($G(^PXRMD(811.4,Y,0)),U,1)
  1.  Q $S($D(CFLIST(CFNAME)):1,1:0)
  1.  ;
  1.  ;==========================================
  1. DELDEFAD ;Delete file #811.9 field #.01 "AD" cross-reference.
  1.  N MSG
  1.  D DELIX^DDMOD(811.9,.01,2,"","","MSG")
  1.  Q
  1.  ;
  1.  ;==========================================
  1. DELTAXDD ;Delete the taxonomy data dictionary.
  1.  N DIU
  1.  S DIU=811.2,DIU(0)="ET"
  1.  D EN^DIU2
  1.  Q
  1.  ;
  1.  ;==========================================
  1. DELETAX ;Delete the expanded taxonomy file.
  1.  N DIU
  1.  S DIU=811.3,DIU(0)="DT"
  1.  D EN^DIU2
  1.  Q
  1.  ;
  1.  ;==========================================
  1. DELVSDD ;Delete the value set files.
  1.  N DIU,FILENUM
  1.  F FILENUM=802.1,802.2,802.3 D
  1.  . S DIU=FILENUM,DIU(0)="DT"
  1.  . D EN^DIU2
  1.  Q
  1.  ;
  1.  ;==========================================
  1. DELETEP() ;
  1.  N DA,DIK
  1.  S DIK="^PXRMD(801.45,",DA=$O(^PXRMD(801.45,"B","SNOMED","")) I +$G(DA)'>0 Q
  1.  D ^DIK
  1.  Q
  1.  ;==========================================
  1. PRE ;Pre-init
  1.  ;Disable options and protocols
  1.  D OPTIONS^PXRMUTIL("DISABLE","Install of PXRM*2.0*47")
  1.  D PROTCOLS^PXRMUTIL("DISABLE","Install of PXRM*2.0*47")
  1.  D DELTAXDD^PXRMP47I
  1.  D DELVSDD^PXRMP47I
  1.  Q
  1.  ;
  1.  ;==========================================
  1. POST ;Post-init
  1.  D DELETEP
  1.  D RMOBSFD^PXRMP47I
  1.  D RBLD20IA^PXRMTAXD
  1.  D VSINS^PXRMP47I
  1.  D UCDIA^PXRMP47I
  1.  D UCFREQ^PXRMP47I
  1.  D DELDEFAD^PXRMP47I
  1.  D DELETAX^PXRMP47I
  1.  ;Enable options and protocols
  1.  D OPTIONS^PXRMUTIL("ENABLE","Install of PXRM*2.0*47")
  1.  D PROTCOLS^PXRMUTIL("ENABLE","Install of PXRM*2.0*47")
  1.  D SENDIM^PXRMMSG("PXRM*2.0*47")
  1.  Q
  1.  ;
  1.  ;==========================================
  1. RMOBSFD ;Remove obsolete field data.
  1.  N IEN,NAME
  1.  D BMES^XPDUTL("Removing obsolete field data")
  1.  S NAME=""
  1.  F  S NAME=$O(^PXD(811.2,"B",NAME)) Q:NAME=""  D
  1.  . D MES^XPDUTL(" Working on taxonomy "_NAME)
  1.  . S IEN=""
  1.  . F  S IEN=$O(^PXD(811.2,"B",NAME,IEN)) Q:IEN=""  D
  1.  ..;Brief Description
  1.  .. S $P(^PXD(811.2,IEN,0),U,2)=""
  1.  ..;Dialog Header Text
  1.  .. S $P(^PXD(811.2,IEN,0),U,3)=""
  1.  ..;ICD9 Range of Codes
  1.  .. K ^PXD(811.2,IEN,80)
  1.  ..;ICD0 Range of Codes
  1.  .. K ^PXD(811.2,IEN,80.1)
  1.  ..;CPT Range of Codes
  1.  .. K ^PXD(811.2,IEN,81)
  1.  ..;Selectable Codes
  1.  .. K ^PXD(811.2,IEN,"SDX")
  1.  ..;Selectable Procedures
  1.  .. K ^PXD(811.2,IEN,"SPR")
  1.  ..;Dialog Parameters:
  1.  ..;(#3106) GENERATE DIALOG DX PARAMETER [1S] ^ (#3107) CURRENT VISIT
  1.  ..;DX DIALOG HDR [2F] ^ (#3108) HISTORICAL VISIT DX DIALOG HDR [3F] ^
  1.  .. K ^PXD(811.2,IEN,"SDZ")
  1.  ..;(#3110) GENERATE DIALOG PR PARAMETER [1S] ^
  1.  ..;(#3111) CURRENT VISIT PR DIALOG HDR [2F] ^ (#3112) HISTORICAL 
  1.  ..;VISIT PR DIALOG HDR [3F]
  1.  .. K ^PXD(811.2,IEN,"SPZ")
  1.  Q
  1.  ;
  1.  ;==========================================
  1. UCDIA ;Change the DO IN ADVANCE TIME FRAME input transform so it will always
  1.  ;be stored as upper case and make sure all existing entries are
  1.  ;upper case.
  1.  N DIA,FDA,FREQ,IEN,IENS,IND,MSG,TEXT
  1.  D BMES^XPDUTL("Making sure all DO IN ADVANCE TIME FRAMEs are uppercase.")
  1.  S $P(^DD(811.9,1.3,0),U,6)="PXRMINTR(.X) X"
  1.  S IEN=0
  1.  F  S IEN=+$O(^PXD(811.9,IEN)) Q:IEN=0  D
  1.  . S DIA=$P(^PXD(811.9,IEN,0),U,4)
  1.  . I DIA="" Q
  1.  . I DIA?1.N1L D
  1.  .. S TEXT(1)=""
  1.  .. S TEXT(2)="Found lower case DO IN ADVANCE TIME FRAME:"
  1.  .. S TEXT(3)=" IEN="_IEN_" DO IN ADVANCE="_DIA
  1.  .. S TEXT(4)=" Changing it to upper case."
  1.  .. D MES^XPDUTL(.TEXT)
  1.  .. S DIA=$$UP^XLFSTR(DIA)
  1.  .. S $P(^PXD(811.9,IEN,0),U,4)=DIA
  1.  Q
  1.  ;
  1.  ;==========================================
  1. UCFREQ ;Change the reminder frequency input transform so they will always
  1.  ;be stored as upper case and make sure all existing frequencies are
  1.  ;upper case.
  1.  N FDA,FREQ,IEN,IENS,IND,MSG,TEXT
  1.  D BMES^XPDUTL("Making sure all reminder frequencies are uppercase.")
  1.  ;Baseline
  1.  S $P(^DD(811.97,.01,0),U,6)="PXRMINTR(.X) X"
  1.  ;Finding modifier
  1.  S $P(^DD(811.902,3,0),U,6)="PXRMINTR(.X) X"
  1.  S IEN=0
  1.  F  S IEN=+$O(^PXD(811.9,IEN)) Q:IEN=0  D
  1.  .;Baseline
  1.  . S IND=0
  1.  . F  S IND=+$O(^PXD(811.9,IEN,7,IND)) Q:IND=0  D
  1.  .. S FREQ=$P(^PXD(811.9,IEN,7,IND,0),U,1)
  1.  .. I FREQ?1.N1L D
  1.  ... S TEXT(1)=""
  1.  ... S TEXT(2)="Found lower case baseline frequency:"
  1.  ... S TEXT(3)=" IEN="_IEN_" IND="_IND_" Frequency="_FREQ
  1.  ... S TEXT(4)=" Changing it to upper case."
  1.  ... D MES^XPDUTL(.TEXT)
  1.  ... S FREQ=$$UP^XLFSTR(FREQ)
  1.  ... S IENS=IND_","_IEN_","
  1.  ... S FDA(811.97,IENS,.01)=FREQ
  1.  ... D FILE^DIE("ET","FDA","MSG")
  1.  .;Findings
  1.  . S IND=0
  1.  . F  S IND=+$O(^PXD(811.9,IEN,20,IND)) Q:IND=0  D
  1.  .. S FREQ=$P(^PXD(811.9,IEN,20,IND,0),U,4)
  1.  .. I FREQ?1.N1L D
  1.  ... S TEXT(1)=""
  1.  ... S TEXT(2)="Found lower case finding frequency:"
  1.  ... S TEXT(3)=" IEN="_IEN_" Finding="_IND_" Frequency="_FREQ
  1.  ... S TEXT(4)=" Changing it to upper case."
  1.  ... D MES^XPDUTL(.TEXT)
  1.  ... S FREQ=$$UP^XLFSTR(FREQ)
  1.  ... S $P(^PXD(811.9,IEN,20,IND,0),U,4)=FREQ
  1.  Q
  1.  ;
  1.  ;==========================================
  1. VSINS ;Install the value set file data.
  1.  N FILENUM
  1.  D BMES^XPDUTL("Installing Value Set data.")
  1.  F FILENUM=802.1,802.2,802.3 M ^PXRM(FILENUM)=@XPDGREF@(FILENUM)
  1.  Q
  1.  ;
  1.  ;==========================================
  1. VSSAVE ;Pre-Transportation routine; save the value set file data in the
  1.  ;transport global.
  1.  N FILENUM
  1.  F FILENUM=802.1,802.2,802.3 M @XPDGREF@(FILENUM)=^PXRM(FILENUM)
  1.  Q
  1.  ;