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

MHV1P74.m

Go to the documentation of this file.
  1. MHV1P74 ;MHV/CFS - MHV*1*74 POST INIT: PHARMACY FIELDS UPDATE;
  1. ;;1.0;My HealtheVet;**74**;Aug 23, 2005;Build 42
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. POST ; New pharmacy fields POST-INSTALL
  1. ;
  1. D RTYP ; Add new MHV REQUEST TYPE (#2275.3)
  1. ;
  1. D REINDX ;Re-index the new "AE" cross reference field 8 in the PRESCRIPTION REFILE REQUEST file.
  1. Q
  1. ;
  1. RTYP ; Add New MHV REQUEST TYPE MEDICATIONS2 (#2275.3)
  1. N FLDS,ERR,NEW
  1. ;
  1. I $D(^MHV(2275.3,"B","MEDICATIONS2")) D Q
  1. . ;D LOG^MHVUL2("MHV1P74","MHV REQUEST TYPE EXISTS - NOT ADDED","S","TRACE")
  1. . S ^XTMP("MHV1P74",$J,"MEDICATIONS2")="MEDICATIONS2 ALREADY EXISTS"
  1. . D MES^XPDUTL("MEDICATIONS2 ALREADY EXISTS, NOT ADDED")
  1. ;
  1. S DUZ=.5
  1. S DT=$$DT^XLFDT
  1. S FLDS("REQUEST TYPE")="MEDICATIONS2"
  1. S FLDS("NUMBER")=51
  1. S FLDS("BLOCK")=0
  1. S FLDS("REALTIME")=1
  1. S FLDS("EXECUTE")="EXTRACT~MHVXRXM2"
  1. S FLDS("BUILDER")="MHV7B1R2"
  1. S FLDS("DATATYPE")="Medications2"
  1. S FLDS("DESCRIPTION",1)="QBP^Q13 query for Medications"
  1. S FLDS("DESCRIPTION",2)="from multiple SOURCES including RX renewal data"
  1. S NEW=1 ;set to 1 for new entry or 0 to update an entry
  1. D UPDREQ^MHVU2(.FLDS,NEW,.ERR)
  1. I ERR'="" D
  1. . S ^XTMP("MPV1P74",$J,"ERROR")=ERR
  1. . D MES^XPDUTL("COULD NOT CREATE MEDICATIONS2 IN FILE 2275.3 DUE TO "_ERR)
  1. Q
  1. ;
  1. REINDX ;Re-index field 8 (PRESCRIPTION IEN) in file 52.43.
  1. K DIK,DA
  1. D MES^XPDUTL("Re-indexing the AE cross reference of the PRESCRIPTION REFILL REQUEST file")
  1. S LASTI=$P($G(^PS(52.43,0)),"^",4) Q:'LASTI
  1. S STARTI=LASTI-100000
  1. I STARTI<0 S STARTI=LASTI-(LASTI\10)
  1. S XI=STARTI
  1. S DIK="^PS(52.43,",DIK(1)="8^AE"
  1. F S XI=$O(^PS(52.43,XI)) Q:'XI D ;
  1. .S DA=XI D EN1^DIK ;Rebuild AE cross reference at the file level
  1. Q