Routine: APSPEC04

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...",!

MES(TXT,QUIT) ;EP

 D BMES^XPDUTL("  "_$G(TXT))

 S:$G(QUIT) XPDABORT=QUIT

PRE ;EP - Pre-init

 D RENXPAR("CIAZPRX LOG MESSAGES","APSPPCC LOG MESSAGES")

 D REMXPAR("CIAZPRX PHARMACY LOCATION") ; Remove existing values for parameter

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")

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

POST ;EP

 D REGPROT^CIAURPC("PS EVSEND OR","IHS PS HOOK")

 D FIXCMF

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) "."

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

APSPEC04.m