MHV1P74 ;MHV/CFS - MHV*1*74 POST INIT: PHARMACY FIELDS UPDATE;
;;1.0;My HealtheVet;**74**;Aug 23, 2005;Build 42
;;Per VHA Directive 2004-038, this routine should not be modified.
;
Q
;
POST ; New pharmacy fields POST-INSTALL
;
D RTYP ; Add new MHV REQUEST TYPE (#2275.3)
;
D REINDX ;Re-index the new "AE" cross reference field 8 in the PRESCRIPTION REFILE REQUEST file.
Q
;
RTYP ; Add New MHV REQUEST TYPE MEDICATIONS2 (#2275.3)
N FLDS,ERR,NEW
;
I $D(^MHV(2275.3,"B","MEDICATIONS2")) D Q
. ;D LOG^MHVUL2("MHV1P74","MHV REQUEST TYPE EXISTS - NOT ADDED","S","TRACE")
. S ^XTMP("MHV1P74",$J,"MEDICATIONS2")="MEDICATIONS2 ALREADY EXISTS"
. D MES^XPDUTL("MEDICATIONS2 ALREADY EXISTS, NOT ADDED")
;
S DUZ=.5
S DT=$$DT^XLFDT
S FLDS("REQUEST TYPE")="MEDICATIONS2"
S FLDS("NUMBER")=51
S FLDS("BLOCK")=0
S FLDS("REALTIME")=1
S FLDS("EXECUTE")="EXTRACT~MHVXRXM2"
S FLDS("BUILDER")="MHV7B1R2"
S FLDS("DATATYPE")="Medications2"
S FLDS("DESCRIPTION",1)="QBP^Q13 query for Medications"
S FLDS("DESCRIPTION",2)="from multiple SOURCES including RX renewal data"
S NEW=1 ;set to 1 for new entry or 0 to update an entry
D UPDREQ^MHVU2(.FLDS,NEW,.ERR)
I ERR'="" D
. S ^XTMP("MPV1P74",$J,"ERROR")=ERR
. D MES^XPDUTL("COULD NOT CREATE MEDICATIONS2 IN FILE 2275.3 DUE TO "_ERR)
Q
;
REINDX ;Re-index field 8 (PRESCRIPTION IEN) in file 52.43.
K DIK,DA
D MES^XPDUTL("Re-indexing the AE cross reference of the PRESCRIPTION REFILL REQUEST file")
S LASTI=$P($G(^PS(52.43,0)),"^",4) Q:'LASTI
S STARTI=LASTI-100000
I STARTI<0 S STARTI=LASTI-(LASTI\10)
S XI=STARTI
S DIK="^PS(52.43,",DIK(1)="8^AE"
F S XI=$O(^PS(52.43,XI)) Q:'XI D ;
.S DA=XI D EN1^DIK ;Rebuild AE cross reference at the file level
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMHV1P74 1771 printed Sep 11, 2024@02:35:35 Page 2
MHV1P74 ;MHV/CFS - MHV*1*74 POST INIT: PHARMACY FIELDS UPDATE;
+1 ;;1.0;My HealtheVet;**74**;Aug 23, 2005;Build 42
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
POST ; New pharmacy fields POST-INSTALL
+1 ;
+2 ; Add new MHV REQUEST TYPE (#2275.3)
DO RTYP
+3 ;
+4 ;Re-index the new "AE" cross reference field 8 in the PRESCRIPTION REFILE REQUEST file.
DO REINDX
+5 QUIT
+6 ;
RTYP ; Add New MHV REQUEST TYPE MEDICATIONS2 (#2275.3)
+1 NEW FLDS,ERR,NEW
+2 ;
+3 IF $DATA(^MHV(2275.3,"B","MEDICATIONS2"))
Begin DoDot:1
+4 ;D LOG^MHVUL2("MHV1P74","MHV REQUEST TYPE EXISTS - NOT ADDED","S","TRACE")
+5 SET ^XTMP("MHV1P74",$JOB,"MEDICATIONS2")="MEDICATIONS2 ALREADY EXISTS"
+6 DO MES^XPDUTL("MEDICATIONS2 ALREADY EXISTS, NOT ADDED")
End DoDot:1
QUIT
+7 ;
+8 SET DUZ=.5
+9 SET DT=$$DT^XLFDT
+10 SET FLDS("REQUEST TYPE")="MEDICATIONS2"
+11 SET FLDS("NUMBER")=51
+12 SET FLDS("BLOCK")=0
+13 SET FLDS("REALTIME")=1
+14 SET FLDS("EXECUTE")="EXTRACT~MHVXRXM2"
+15 SET FLDS("BUILDER")="MHV7B1R2"
+16 SET FLDS("DATATYPE")="Medications2"
+17 SET FLDS("DESCRIPTION",1)="QBP^Q13 query for Medications"
+18 SET FLDS("DESCRIPTION",2)="from multiple SOURCES including RX renewal data"
+19 ;set to 1 for new entry or 0 to update an entry
SET NEW=1
+20 DO UPDREQ^MHVU2(.FLDS,NEW,.ERR)
+21 IF ERR'=""
Begin DoDot:1
+22 SET ^XTMP("MPV1P74",$JOB,"ERROR")=ERR
+23 DO MES^XPDUTL("COULD NOT CREATE MEDICATIONS2 IN FILE 2275.3 DUE TO "_ERR)
End DoDot:1
+24 QUIT
+25 ;
REINDX ;Re-index field 8 (PRESCRIPTION IEN) in file 52.43.
+1 KILL DIK,DA
+2 DO MES^XPDUTL("Re-indexing the AE cross reference of the PRESCRIPTION REFILL REQUEST file")
+3 SET LASTI=$PIECE($GET(^PS(52.43,0)),"^",4)
if 'LASTI
QUIT
+4 SET STARTI=LASTI-100000
+5 IF STARTI<0
SET STARTI=LASTI-(LASTI\10)
+6 SET XI=STARTI
+7 SET DIK="^PS(52.43,"
SET DIK(1)="8^AE"
+8 ;
FOR
SET XI=$ORDER(^PS(52.43,XI))
if 'XI
QUIT
Begin DoDot:1
+9 ;Rebuild AE cross reference at the file level
SET DA=XI
DO EN1^DIK
End DoDot:1
+10 QUIT
