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

PXRMV1I.m

Go to the documentation of this file. 
  1. PXRMV1I ; SLC/PJH,PKR - Inits for new REMINDER package. ;06/08/2000
  1.  ;;1.5;CLINICAL REMINDERS;;Jun 19, 2000
  1.  ;IHS/ITSC/LJF 5/30/2003 fixed call to PXRMCOPY - has different # of parameters
  1.  ;                       bypassed connecting the findings to the terms for the
  1.  ;                          VA-HEP C RISK ASSESSMENT reminder - variable ptr problem
  1.  ;                          prevented sending any data in file 811.5 - Reminder Term
  1.  ;
  1.  Q
  1.  ;
  1.  ;------------------------
  1. BLDLSTR ;Make sure all the logic strings get built.
  1.  D BMES^XPDUTL("Building logic strings")
  1.  N IEN
  1.  S IEN=0
  1.  F  S IEN=$O(^PXD(811.9,IEN)) Q:+IEN=0  D
  1.  . I $P(^PXD(811.9,IEN,0),U,1)["VA-" Q
  1.  . D BLDPCLS^PXRMLOGX(IEN,"")
  1.  . D BLDRESLS^PXRMLOGX(IEN,"")
  1.  . D BLDAFL^PXRMLOGX(IEN,"")
  1.  . D BLDINFL^PXRMLOGX(IEN,"")
  1.  Q
  1.  ;
  1.  ;----------------------------------------------------------------
  1. CHECK(ROUTINE) ;Search for routine entry point in the new computed findings
  1.  ;file
  1.  N SUB,TAG,FOUND
  1.  S SUB=0,FOUND=""
  1.  F  S SUB=$O(^PXRMD(811.4,SUB)) Q:'SUB  D  Q:FOUND]""
  1.  .S TAG=$P($G(^PXRMD(811.4,SUB,0)),U,2,3)
  1.  .I $P(TAG,U,2)_";"_$P(TAG,U)=ROUTINE S FOUND=SUB
  1.  Q FOUND
  1.  ;
  1.  ;--------------------------------------
  1. COMP ;Computed findings - set up file #811.4
  1.  N ARRAY,DATA,DESC,IEN,STRING,SUB,TAG,FDA,FDAIEN
  1.  ;Get each reminder in turn
  1.  S STRING="Building Computed Findings file"
  1.  D BMES^XPDUTL(STRING)
  1.  ;Make sure any converted computed findings go into the site's
  1.  ;number space.
  1.  ;D SETSTART^PXRMCOPY("^PXRMD(811.4,",0)   ;IHS/ITSC/LJF 5/30/2003
  1.  D SETSTART^PXRMCOPY("^PXRMD(811.4,")      ;IHS/ITSC/LJF 5/30/2003 wrong # of parameters
  1.  S IEN=0
  1.  F  S IEN=$O(^PXD(811.9,IEN)) Q:'IEN  D
  1.  .;Skip VA- reminders
  1.  .I $P(^PXD(811.9,IEN,0),U,1)["VA-" Q
  1.  .I $D(REDO) Q:IEN'=REMINDER
  1.  .S SUB=0
  1.  .;Get computed findings records
  1.  .F  S SUB=$O(^PXD(811.9,IEN,10,SUB)) Q:'SUB  D
  1.  ..S DATA=$G(^PXD(811.9,IEN,10,SUB,0)) Q:DATA=""
  1.  ..;Extract description and routine entry point
  1.  ..S TAG=$P(DATA,U),DESC=$P(DATA,U,5)
  1.  ..;Ignore null Computed findings
  1.  ..I TAG="" Q
  1.  ..;Default null name to routine name
  1.  ..I DESC="" S DESC=TAG
  1.  ..;Create ARRAY of routine entry points
  1.  ..;(using first short description found)
  1.  ..I '$D(ARRAY(TAG)) S ARRAY(TAG)=DESC Q
  1.  ..;If already set-up ignore
  1.  ..I ARRAY(TAG)=DESC Q
  1.  ..;Otherwise log duplication
  1.  ..S STRING="The following CF's use the same routine"
  1.  ..D BMES^XPDUTL(STRING)
  1.  ..D BMES^XPDUTL(ARRAY(TAG)_" (retained)")
  1.  ..D BMES^XPDUTL(DESC_" (replaced)")
  1.  ;
  1.  ;Create FDA for each entry in ARRAY
  1.  S TAG=""
  1.  F  S TAG=$O(ARRAY(TAG)) Q:TAG=""  D  Q:$D(MSG)
  1.  .S DESC=ARRAY(TAG)
  1.  .;Check if entry already exists
  1.  .I $$CHECK(TAG) D  Q
  1.  ..S STRING="Skipping update - CF "_DESC
  1.  ..D BMES^XPDUTL(STRING)
  1.  .;Build FDA array
  1.  .K FDAIEN,FDA
  1.  .;Description
  1.  .S FDA(811.4,"+1,",.01)=DESC
  1.  .;Routine
  1.  .S FDA(811.4,"+1,",.02)=$P(TAG,";",2)
  1.  .;Entry Point
  1.  .S FDA(811.4,"+1,",.03)=$P(TAG,";")
  1.  .;Print name, default to the .01 field
  1.  .S FDA(811.4,"+1,",.04)=DESC
  1.  .D UPDATE^DIE("","FDA","FDAIEN","MSG")
  1.  .I $D(MSG) D ERR
  1.  Q
  1.  ;
  1.  ;------------------------
  1. DELCF ;Delete any existing entries in the computed findings file.
  1.  ;Skip those in a site number space. This will apply to test
  1.  ;sites only.
  1.  N DA,DIK,SNUMS
  1.  S SNUMS=100000
  1.  S DIK="^PXRMD(811.4,"
  1.  S DA=0
  1.  F  S DA=$O(^PXRMD(811.4,DA)) Q:(+DA=0)!(+DA>SNUMS)  D
  1.  . D ^DIK
  1.  Q
  1.  ;
  1.  ;------------------------
  1. DELDD ;Delete data dictionaries
  1.  N DIU,FILENUM
  1.  S DIU(0)=""
  1.  F FILENUM=800,801.41,801.42,801.43,801.45,801.9,801.95,810.1,811.2,811.3,811.4,811.5,811.6,811.7,811.9 D
  1.  . S DIU=FILENUM
  1.  . D EN^DIU2
  1.  Q
  1.  ;
  1.  ;------------------------
  1. DELMH ;Delete any existing MH result entries in dialog file.
  1.  ;Skip those in a site number space. This will apply to test
  1.  ;sites only.
  1.  N DA,DIK,DTYP,SNUMS
  1.  S SNUMS=100000
  1.  S DIK="^PXRMD(801.41,"
  1.  S DA=0
  1.  F  S DA=$O(^PXRMD(801.41,DA)) Q:(+DA=0)!(+DA>SNUMS)  D
  1.  .;Dialog type
  1.  .S DTYP=$P($G(^PXRMD(801.41,DA,0)),U,4)
  1.  .;Delete only result groups and result elements
  1.  .I (DTYP="T")!(DTYP="S") D ^DIK
  1.  Q
  1.  ;
  1.  ;------------------------
  1. DELORD ;Delete obsolete reminder definitions.
  1.  N DA,DIK
  1.  S DIK="^PXD(811.9,"
  1.  S DA=+$O(^PXD(811.9,"B","VA-*SEAT BELT AND ACCIDENT SCREEN",""))
  1.  I DA>0 D ^DIK
  1.  S DA=+$O(^PXD(811.9,"B","VA-SEAT BELT EDUCATION",""))
  1.  I DA>0 D ^DIK
  1.  S DA=+$O(^PXD(811.9,"B","VA-*TETANUS DIPTHERIA IMMUNIZATION",""))
  1.  I DA>0 D ^DIK
  1.  Q
  1.  ;
  1.  ;------------------------
  1. DELXTAX ;Delete all expanded taxonomies
  1.  N DA,DIK
  1.  S DIK="^PXD(811.3,"
  1.  S DA=0
  1.  F  S DA=$O(^PXD(811.3,DA)) Q:+DA=0  D
  1.  . D ^DIK
  1.  Q
  1.  ;
  1.  ;----------------------------------
  1. DPCACHE ;Delete any existing patient caches
  1.  N IND
  1.  S IND="PXRMDFN"
  1.  F  S IND=$O(^XTMP(IND)) Q:IND'["PXRMDFN"  D
  1.  . K ^XTMP(IND)
  1.  Q
  1.  ;
  1.  ;-------------
  1. ERR ;Error Handler
  1.  N ERROR,IC,REF
  1.  S ERROR(1)="Unable to convert computed finding : "_DESC
  1.  S ERROR(2)="Reminder conversion abandoned"
  1.  S ERROR(3)="Error in UPDATE^DIE, needs further investigation"
  1.  ;Move MSG into ERROR
  1.  S REF="MSG"
  1.  F IC=4:1 S REF=$Q(@REF) Q:REF=""  S ERROR(IC)=REF_"="_@REF
  1.  ;Screen message
  1.  D BMES^XPDUTL(.ERROR)
  1.  ;Mail Message
  1.  D ERR^PXRMV1IE(.ERROR)
  1.  Q
  1.  ;
  1.  ;----------------------------------
  1. NEWB ;Get ready for new style B cross-references.
  1.  N FILE
  1.  F FILE=801.41,811.9 D
  1.  . D RMDUP^PXRMV1IG(FILE)
  1.  . D TMPB^PXRMV1IG(FILE)
  1.  Q
  1.  ;
  1.  ;----------------------------------
  1. PARM ;Copy site disclaimer from PCE file
  1.  S STRING="Saving site disclaimer"
  1.  D BMES^XPDUTL(STRING)
  1.  M ^PXRM(800,1,"DISC2")=^PX(815,1,"HS2")
  1.  Q
  1.  ;
  1.  ;-------------------------------------
  1. PRE ;These are the pre-installation actions
  1.  ;Get ready for new style B cross-references.
  1.  D NEWB
  1.  ;Save inactive statuses of VA reminders
  1.  D INSAV^PXRMV1IG
  1.  ;Rename menu options
  1.  D CHANGE^PXRMV1IG
  1.  ;Delete any existing entries in the computed findings file.
  1.  D DELCF
  1.  ;Delete any existing MH test result groups or elements
  1.  D DELMH
  1.  ;Delete data dictionaries for all files with a new DD or DD changes.
  1.  D DELDD
  1.  Q
  1.  ;
  1.  ;---------------------------------------
  1. POST ;These are the post-installation actions
  1.  N MSG
  1.  ;Parameters
  1.  D PARM
  1.  ;Parameter Definitions
  1.  D ^PXRMV1X
  1.  ;Computed Findings
  1.  D COMP Q:$D(MSG)
  1.  ;Reminders
  1.  D RBLD^PXRMV1IA Q:$D(MSG)
  1.  D DELXTAX
  1.  D DPCACHE
  1.  ;Taxonomy selectable codes
  1.  D ^PXRMV1ID
  1.  ;Make sure all the logic strings get built.
  1.  D BLDLSTR
  1.  ;Rebuild indexes.
  1.  D REINDEX
  1.  ;Make sure no spurious duplicate entries were created with the
  1.  ;new B cross-reference.
  1.  D RMDUP
  1.  ;Delete obsolete reminder definitions.
  1.  D DELORD
  1.  ;Restore VA reminder inactive statuses.
  1.  D INRES^PXRMV1IG
  1.  ;Connect the findings to the terms for the VA-HEP C RISK ASSESSMENT
  1.  ;reminder
  1.  ;D CTERMS^PXRMV1IH    ;IHS/ITSC/LJF 5/30/2003 bypass - could not send reminder data due to v pointer problems
  1.  ;Set starting ien to site number space.
  1.  D SETSTART
  1.  Q
  1.  ;
  1.  ;------------------------
  1. REDO ;Reset Selected Reminders
  1.  N MSG,PXRMREM,REDO,REMINDER
  1.  D REM(.PXRMREM)
  1.  S REMINDER=$P($G(PXRMREM(1)),U)
  1.  I REMINDER D
  1.  . S REDO=1
  1.  . D COMP Q:$D(MSG)
  1.  . D RBLD^PXRMV1IA
  1.  Q
  1.  ;
  1.  ;------------------
  1. REINDEX ;Rebuild all cross-references that have been changed to the new style
  1.  N FILE
  1.  F FILE=801.41,811.2,811.4,811.5,811.6,811.7,811.9 D
  1.  . D REINDEX^PXRMV1IG(FILE)
  1.  Q
  1.  ;
  1.  ;------------------
  1. REM(REM) ;Reminder Selection
  1.  N LIT,LIT1,DIC
  1.  S DIC("A")="REMINDER to convert: "
  1.  S LIT1="You must select a reminder!"
  1.  D SEL(811.9,"AEQMZ",.REM)
  1.  Q
  1.  ;
  1.  ;-------------------------
  1. RMDUP ;Remove duplicate entries
  1.  N FILE
  1.  F FILE=801.41,811.9 D
  1.  . D RMDUP^PXRMV1IG(FILE)
  1.  Q
  1.  ;
  1.  ;Repeated Prompt using DIC
  1.  ;-------------------------
  1. SEL(FILE,MODE,ARRAY) ;
  1.  N X,Y,CNT
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S CNT=0
  1.  W !
  1.  F  D  Q:$D(DTOUT)  Q:$D(DUOUT)  Q:CNT>0  Q:(Y=-1)&(CNT>0)
  1.  .S DIC=FILE,DIC(0)=MODE
  1.  .D ^DIC
  1.  .I X=(U_U) S DTOUT=1
  1.  .I '$D(DTOUT),('$D(DUOUT)) D
  1.  ..I +Y'=-1 D  Q
  1.  ...S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3)
  1.  ..W:CNT=0 !,LIT1
  1.  .K DIC
  1.  Q
  1.  ;-------------------------
  1. SETSTART ;Set starting ien to site number space.
  1.  N FILE,ROOT
  1.  F FILE=811.2,811.4,811.5,811.6,811.9 D
  1.  . S ROOT=$$ROOT^DILFD(FILE)
  1.  . ;D SETSTART^PXRMCOPY(ROOT,0)   ;IHS/ITSC/LJF 5/30/2003
  1.  . D SETSTART^PXRMCOPY(ROOT)      ;IHS/ITSC/LJF 5/30/2003 wrong # of parameters
  1.  F FILE=801.41 D
  1.  . S ROOT=$$ROOT^DILFD(FILE)
  1.  . ;D SETSTART^PXRMDCPY(ROOT,0)   ;IHS/ITSC/LJF 5/30/2003
  1.  . D SETSTART^PXRMCOPY(ROOT)      ;IHS/ITSC/LJF 5/30/2003 wrong routine & # of parameters
  1.  Q
  1.  ;