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

APSPEC14.m

Go to the documentation of this file.
  1. APSPEC14 ;IHS/CIA/PLS - APSP ENVIRONMENT CHECK ROUTINE ;25-May-2012 17:17;PLS
  1. ;;7.0;IHS PHARMACY MODIFICATIONS;**1014**;Sep 23, 2004;Build 5
  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 1014.",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. Q
  1. ;
  1. LMCLNUP ;EP-
  1. N IEN,IENC,FDA
  1. S IEN=$$FIND1^DIC(409.61,,"X","APSP COMPLETE ORDERS")
  1. Q:'IEN
  1. S IENC=$$FIND1^DIC(409.621,","_IEN_",","X","ORDNUM")
  1. Q:'IENC
  1. S FDA(409.621,IENC_","_IEN_",",.01)="@"
  1. D FILE^DIE("K","FDA")
  1. Q
  1. ;
  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 DATA,INSDT
  1. I $$INSTALDT^XPDUTL("APSP*7.0*1013",.DATA) D
  1. .S INSDT=$P($O(DATA(0)),".")
  1. .D FIXEXP(INSDT)
  1. Q
  1. ;
  1. FIXEXP(INSDT) ; EP-
  1. N FDT,RX,DRG,EXTEXP,X2,NEXPDT,ISSDT,RX0
  1. S FDT=INSDT-.01 F S FDT=$O(^PSRX("AD",FDT)) Q:'FDT D
  1. .S RX=0 F S RX=$O(^PSRX("AD",FDT,RX)) Q:'RX D
  1. ..Q:'$$RMNRFL^APSPFUNC(RX) ;quit if no remaining fills
  1. ..N DA,DR,DIE
  1. ..S RX0=^PSRX(RX,0)
  1. ..S DRG=+$P(RX0,U,6)
  1. ..S ISSDT=$P(RX0,U,13)
  1. ..Q:'$$ISSCH^APSPFNC2(DRG,"345") ;quit if not a schedule 3-5 drug
  1. ..S EXTEXP=$$GET1^DIQ(50,DRG,9999999.08)
  1. ..S X2=$S(EXTEXP:EXTEXP,1:184)
  1. ..S NEXPDT=$$FMADD^XLFDT(ISSDT,X2)
  1. ..S DA=RX,DIE="^PSRX("
  1. ..S DR="26///"_NEXPDT D ^DIE
  1. ..W !,"Fixed Expiration date for RX IEN: "_RX
  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. ; UnRegister a protocol from an extended action protocol
  1. ; Input: P-Parent protocol
  1. ; C-Child protocol
  1. UREGPROT(P,C,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 IENARY(2)=$$FIND1^DIC(101.01,","_IENARY(1)_",","",C)
  1. .S FDA(101.01,IENARY(2)_","_IENARY(1)_",",.01)="@"
  1. .D UPDATE^DIE("S","FDA","","ERR")
  1. Q
  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