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

APSPEC11.m

Go to the documentation of this file. 
  1. APSPEC11 ;IHS/CIA/PLS - APSP ENVIRONMENT CHECK ROUTINE ;09-Jun-2011 11:50;PLS
  1.  ;;7.0;IHS PHARMACY MODIFICATIONS;**1011**;Sep 23, 2004;Build 17
  1.  ;
  1. ENV ;EP
  1.  ;
  1.  S X=$$GET1^DIQ(200,DUZ,.01)
  1.  W !!,$$CJ^XLFSTR("Hello, "_$P(X,",",2)_" "_$P(X,","),IOM)
  1.  W !!,$$CJ^XLFSTR("Checking Environment for "_$P($T(+2),";",4)_" V "_$P($T(+2),";",3)_", Patch 1011.",IOM)
  1.  S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0  ; Suppress the Disable options and Move routines prompts
  1.  S XPDABORT=0
  1.  I 'XPDABORT D
  1.  .W !!,"All requirements for installation have been met...",!
  1.  E  D
  1.  .W !!,"Unable to continue with the installation...",!
  1.  Q
  1.  ;
  1. MES(TXT,QUIT) ;EP
  1.  D BMES^XPDUTL("  "_$G(TXT))
  1.  S:$G(QUIT) XPDABORT=QUIT
  1.  Q
  1.  ;
  1. PRE ;EP - Pre-init
  1.  D RENXPAR("APSP AUTO RX ERX OF CS","APSP AUTO RX ERX OF CS II")
  1.  Q
  1. RENXPAR(OLD,NEW) ; Rename parameter
  1.  N IEN,FDA,FIL
  1.  S FIL=8989.51
  1.  Q:$$FIND1^DIC(FIL,,"X",NEW)  ; New name already exists
  1.  S IEN=$$FIND1^DIC(FIL,,"X",OLD)
  1.  Q:'IEN  ; Old name doesn't exist
  1.  S FDA(FIL,IEN_",",.01)=NEW
  1.  D FILE^DIE("E","FDA")
  1.  Q
  1.  ;
  1. REMXPAR(PAR) ;Remove values stored for a given parameter
  1.  N PIEN,ENT,INT,VIEN,DIK,DA
  1.  S PIEN=$O(^XPAR(8989.51,"B",PAR,0))
  1.  Q:'PIEN
  1.  S ENT=0 F  S ENT=$O(^XPAR(8989.5,"AC",PIEN,ENT)) Q:ENT=""  D  ;Entity
  1.  .S INT=0 F  S INT=$O(^XPAR(8989.5,"AC",PIEN,ENT,INT)) Q:INT=""  D  ;Instance
  1.  ..S DA=0 F  S DA=$O(^XPAR(8989.5,"AC",PIEN,ENT,INT,DA)) Q:'DA  D  ;Value IEN
  1.  ...S DIK="^XTV(8989.5," D ^DIK
  1.  Q
  1. POST ;EP
  1.  N DIK
  1.  S DIK="^APSPOPHM(",DIK(1)="1.4^D" D ENALL^DIK
  1.  Q
  1.  ; Add given namespace to Application
  1. AAPPGRP(FILE,NMSP) ;EP
  1.  N FDA,IEN,ERR
  1.  Q:'$G(FILE)!('$L(NMSP))
  1.  S FDA(1.005,"?+1,"_FILE_",",.01)=NMSP
  1.  D UPDATE^DIE("","FDA","IEN","ERR")
  1.  Q
  1.  ; Register a protocol to an extended action protocol
  1.  ; Input: P-Parent protocol
  1.  ;        C-Child protocol
  1.  ;     SEQ-Sequence Number
  1. REGPROT(P,C,SEQ,ERR) ;EP
  1.  N IENARY,PIEN,AIEN,FDA
  1.  D
  1.  .I '$L(P)!('$L(C)) S ERR="Missing input parameter" Q
  1.  .S IENARY(1)=$$FIND1^DIC(101,"","",P)
  1.  .S AIEN=$$FIND1^DIC(101,"","",C)
  1.  .I 'IENARY(1)!'AIEN S ERR="Unknown protocol name" Q
  1.  .S FDA(101.01,"?+2,"_IENARY(1)_",",.01)=AIEN
  1.  .S FDA(101.01,"?+2,"_IENARY(1)_",",3)=SEQ
  1.  .D UPDATE^DIE("S","FDA","IENARY","ERR")
  1.  ;Q:$Q $G(ERR)=""
  1.  Q
  1.  ;
  1. SETPKGV(PKG,VER) ;EP
  1.  N PIEN,FDA
  1.  S PIEN=$$FIND1^DIC(9.4,,,PKG)
  1.  Q:'PIEN
  1.  S FDA(9.4,PIEN_",",13)=VER
  1.  D UPDATE^DIE(,"FDA")
  1.  Q
  1.  ; Cleanup Drug File DD
  1. CLN50DD ;EP -
  1.  S DIU=50.03,DIU(0)="SD" D EN^DIU2
  1.  Q
  1.  ; Cleanup PCC Link in NVA node
  1. CLNNVA ;EP -
  1.  N DFN,IEN,FDA,NVAERR
  1.  S DFN=0 F  S DFN=$O(^PS(55,"APCC","+1",DFN)) Q:'DFN  D
  1.  .S IEN=0 F  S IEN=$O(^PS(55,"APCC","+1",DFN,IEN)) Q:'IEN  D
  1.  ..S FDA(55.05,IEN_","_DFN_",",9999999.11)="@"
  1.  D:$D(FDA) UPDATE^DIE("","FDA",,"NVAERR")
  1.  W:$G(DIERR) $G(NVAERR("DIERR",1,"TEXT",1))
  1.  Q