APSPEC04 ;IHS/CIA/PLS - APSP ENVIRONMENT CHECK ROUTINE ;23-May-2006 20:58;SM
;;7.0;IHS PHARMACY MODIFICATIONS;**1004**;DEC 11, 2003
;
ENV ;EP
;
S X=$$GET1^DIQ(200,DUZ,.01)
W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_", Patch 1004.",IOM)
S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0 ; Suppress the Disable options and Move routines prompts
S XPDABORT=0
D:'$D(^XPD(9.7,"B","PIMS*5.3*1004")) MES("Patch PIMS*5.3*1004 is required and hasn't been installed.",2)
D:'$D(^XPD(9.7,"B","APSP*7.0*1003")) MES("Patch APSP*7.0*1003 is required and hasn't been installed.",2)
I 'XPDABORT D
.W !!,"All requirements for installation have been met...",!
E D
.W !!,"Unable to continue with the installation...",!
Q
;
MES(TXT,QUIT) ;EP
D BMES^XPDUTL(" "_$G(TXT))
S:$G(QUIT) XPDABORT=QUIT
Q
;
PRE ;EP - Pre-init
D RENXPAR("CIAZPRX LOG MESSAGES","APSPPCC LOG MESSAGES")
D REMXPAR("CIAZPRX PHARMACY LOCATION") ; Remove existing values for parameter
Q
RENXPAR(OLD,NEW) ; Rename parameter
N IEN,FDA,FIL
S FIL=8989.51
Q:$$FIND1^DIC(FIL,,"X",NEW) ; New name already exists
S IEN=$$FIND1^DIC(FIL,,"X",OLD)
Q:'IEN ; Old name doesn't exist
S FDA(FIL,IEN_",",.01)=NEW
D FILE^DIE("E","FDA")
Q
;
REMXPAR(PAR) ;Remove values stored for a given parameter
N PIEN,ENT,INT,VIEN,DIK,DA
S PIEN=$O(^XPAR(8989.51,"B",PAR,0))
Q:'PIEN
S ENT=0 F S ENT=$O(^XPAR(8989.5,"AC",PIEN,ENT)) Q:ENT="" D ;Entity
.S INT=0 F S INT=$O(^XPAR(8989.5,"AC",PIEN,ENT,INT)) Q:INT="" D ;Instance
..S DA=0 F S DA=$O(^XPAR(8989.5,"AC",PIEN,ENT,INT,DA)) Q:'DA D ;Value IEN
...S DIK="^XTV(8989.5," D ^DIK
Q
POST ;EP
D REGPROT^CIAURPC("PS EVSEND OR","IHS PS HOOK")
D FIXCMF
Q
;
FIXCMF ; EP - Remove Chronic Med Flag for Discontinued/Deleted Medications
N RX,CNT
D MES("Removing Chronic Med flag on Discontinued/Deleted Medications...")
W !!
S (CNT,RX)=0 F S RX=$O(^PSRX(RX)) Q:'RX D
.S ST=+$P($G(^PSRX(RX,"STA")),U)
.S CNT=CNT+1
.I ST>11&(ST<16) D
..D KILLOCM^PSORN52(RX)
.W:'(CNT#100) "."
Q
APSPEC04 ;IHS/CIA/PLS - APSP ENVIRONMENT CHECK ROUTINE ;23-May-2006 20:58;SM
+1 ;;7.0;IHS PHARMACY MODIFICATIONS;**1004**;DEC 11, 2003
+2 ;
ENV ;EP
+1 ;
+2 SET X=$$GET1^DIQ(200,DUZ,.01)
+3 WRITE !!,$$CJ^XLFSTR("Hello, "_$PIECE(X,",",2)_" "_$PIECE(X,","),IOM)
+4 WRITE !!,$$CJ^XLFSTR("Checking Environment for "_$PIECE($TEXT(+2),";",4)_" V "_$PIECE($TEXT(+2),";",3)_", Patch 1004.",IOM)
+5 ; Suppress the Disable options and Move routines prompts
SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0
+6 SET XPDABORT=0
+7 IF '$DATA(^XPD(9.7,"B","PIMS*5.3*1004"))
DO MES("Patch PIMS*5.3*1004 is required and hasn't been installed.",2)
+8 IF '$DATA(^XPD(9.7,"B","APSP*7.0*1003"))
DO MES("Patch APSP*7.0*1003 is required and hasn't been installed.",2)
+9 IF 'XPDABORT
Begin DoDot:1
+10 WRITE !!,"All requirements for installation have been met...",!
End DoDot:1
+11 IF '$TEST
Begin DoDot:1
+12 WRITE !!,"Unable to continue with the installation...",!
End DoDot:1
+13 QUIT
+14 ;
MES(TXT,QUIT) ;EP
+1 DO BMES^XPDUTL(" "_$GET(TXT))
+2 IF $GET(QUIT)
SET XPDABORT=QUIT
+3 QUIT
+4 ;
PRE ;EP - Pre-init
+1 DO RENXPAR("CIAZPRX LOG MESSAGES","APSPPCC LOG MESSAGES")
+2 ; Remove existing values for parameter
DO REMXPAR("CIAZPRX PHARMACY LOCATION")
+3 QUIT
RENXPAR(OLD,NEW) ; Rename parameter
+1 NEW IEN,FDA,FIL
+2 SET FIL=8989.51
+3 ; New name already exists
IF $$FIND1^DIC(FIL,,"X",NEW)
QUIT
+4 SET IEN=$$FIND1^DIC(FIL,,"X",OLD)
+5 ; Old name doesn't exist
IF 'IEN
QUIT
+6 SET FDA(FIL,IEN_",",.01)=NEW
+7 DO FILE^DIE("E","FDA")
+8 QUIT
+9 ;
REMXPAR(PAR) ;Remove values stored for a given parameter
+1 NEW PIEN,ENT,INT,VIEN,DIK,DA
+2 SET PIEN=$ORDER(^XPAR(8989.51,"B",PAR,0))
+3 IF 'PIEN
QUIT
+4 ;Entity
SET ENT=0
FOR
SET ENT=$ORDER(^XPAR(8989.5,"AC",PIEN,ENT))
IF ENT=""
QUIT
Begin DoDot:1
+5 ;Instance
SET INT=0
FOR
SET INT=$ORDER(^XPAR(8989.5,"AC",PIEN,ENT,INT))
IF INT=""
QUIT
Begin DoDot:2
+6 ;Value IEN
SET DA=0
FOR
SET DA=$ORDER(^XPAR(8989.5,"AC",PIEN,ENT,INT,DA))
IF 'DA
QUIT
Begin DoDot:3
+7 SET DIK="^XTV(8989.5,"
DO ^DIK
End DoDot:3
End DoDot:2
End DoDot:1
+8 QUIT
POST ;EP
+1 DO REGPROT^CIAURPC("PS EVSEND OR","IHS PS HOOK")
+2 DO FIXCMF
+3 QUIT
+4 ;
FIXCMF ; EP - Remove Chronic Med Flag for Discontinued/Deleted Medications
+1 NEW RX,CNT
+2 DO MES("Removing Chronic Med flag on Discontinued/Deleted Medications...")
+3 WRITE !!
+4 SET (CNT,RX)=0
FOR
SET RX=$ORDER(^PSRX(RX))
IF 'RX
QUIT
Begin DoDot:1
+5 SET ST=+$PIECE($GET(^PSRX(RX,"STA")),U)
+6 SET CNT=CNT+1
+7 IF ST>11&(ST<16)
Begin DoDot:2
+8 DO KILLOCM^PSORN52(RX)
End DoDot:2
+9 IF '(CNT#100)
WRITE "."
End DoDot:1
+10 QUIT
