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

BQI21POS.m

Go to the documentation of this file. 
  1. BQI21POS ;VNGT/HS/ALA-Version 2.1 Post Install ; 19 Feb 2009  1:13 PM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1. EN ; Entry point
  1.  ;
  1.  ;Set the version number
  1.  NEW DA
  1.  S DA=$O(^BQI(90508,0))
  1.  S BQIUPD(90508,DA_",",.08)="2.1.0.60"
  1.  S BQIUPD(90508,DA_",",.09)="2.1.0T60"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  ; Remove the alerts glossary from the site parameter file
  1.  K ^BQI(90508,1,16)
  1.  ; Update Mail Merge glossary from the site parameter file
  1.  NEW DA,IEN
  1.  S DA=0
  1.  F  S DA=$O(^BQI(90508,1,17,DA)) Q:'DA  K ^BQI(90508,1,17,DA)
  1.  S IEN=$O(^BQI(90509.9,"B","MAIL MERGE GLOSSARY UPDATE",""))
  1.  I IEN'="" D
  1.  . NEW N
  1.  . S N=0
  1.  . F  S N=$O(^BQI(90509.9,IEN,1,N)) Q:'N  S ^BQI(90508,1,17,N,0)=^BQI(90509.9,IEN,1,N,0)
  1.  . S ^BQI(90508,1,17,0)=^BQI(90509.9,IEN,1,0)
  1.  ;
  1.  ; Add ARV Stability entries to 90506.1
  1.  NEW BI,BJ,BK,BN,BQIUPD,ERROR,IEN,ND,NDATA,TEXT,VAL
  1.  F BI=1:1 S TEXT=$P($T(ARV+BI),";;",2) Q:TEXT=""  D
  1.  . F BJ=1:1:$L(TEXT,"~") D
  1.  .. S NDATA=$P(TEXT,"~",BJ)
  1.  .. S ND=$P(NDATA,"|",1),VAL=$P(NDATA,"|",2)
  1.  .. I ND=0 D
  1.  ... NEW DIC,X,Y
  1.  ... S DIC(0)="LQZ",DIC="^BQI(90506.1,",X=$P(VAL,U,1)
  1.  ... D ^DIC
  1.  ... S IEN=+Y
  1.  ... I IEN=-1 K DO,DD D FILE^DICN S IEN=+Y
  1.  .. I ND=1 S BQIUPD(90506.1,IEN_",",1)=VAL Q
  1.  .. F BK=1:1:$L(VAL,"^") D
  1.  ... S BN=$O(^DD(90506.1,"GL",ND,BK,"")) I BN="" Q
  1.  ... I $P(VAL,"^",BK)'="" S BQIUPD(90506.1,IEN_",",BN)=$P(VAL,"^",BK) Q
  1.  ... I $P(VAL,"^",BK)="" S BQIUPD(90506.1,IEN_",",BN)="@"
  1.  . D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  ; Re-Index File
  1.  K ^BQI(90506.1,"AC"),^BQI(90506.1,"AD")
  1.  NEW DIK
  1.  S DIK="^BQI(90506.1,",DIK(1)=3.01
  1.  D ENALL^DIK
  1.  ;
  1.  ;Update the EHR reminders
  1.  S TJOB="Weekly" D EHR^BQIRMDR1
  1.  ;Update the CMET reminders
  1.  D CMET^BQIRMDR1
  1.  ;
  1.  ; Update pointers for community alerts
  1.  D DX^BQI202PU
  1.  I $G(^BQI(90507.8,2,10,2,0))="" D
  1.  . NEW DXN
  1.  . S $P(^BQI(90507.8,2,10,2,0),U,2)="042.",^BQI(90507.8,2,10,"AC","042.",2)=""
  1.  . S DXN=$O(^ICD9("BA","042. ",""))
  1.  . S $P(^BQI(90507.8,2,10,2,0),U,1)=DXN,^BQI(90507.8,2,10,"B",DXN,2)=""
  1.  NEW CN,TXN,TAX,TTYP,VAL,BQIUPD
  1.  S CN=0
  1.  F  S CN=$O(^BQI(90507.8,CN)) Q:'CN  D
  1.  . S TXN=0
  1.  . F  S TXN=$O(^BQI(90507.8,CN,11,TXN)) Q:'TXN  D
  1.  .. S TAX=$P(^BQI(90507.8,CN,11,TXN,0),U,1)
  1.  .. S TTYP="N"
  1.  .. S VAL=$$STXPT(TAX,TTYP)
  1.  .. NEW DA,IENS
  1.  .. S DA(1)=CN,DA=TXN,IENS=$$IENS^DILF(.DA)
  1.  .. S BQIUPD(90507.811,IENS,.02)=VAL
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  ; Update HMS reminder taxonomy pointers
  1.  S REG=0
  1.  F  S REG=$O(^BQI(90507,REG)) Q:'REG  D
  1.  . S N=0
  1.  . F  S N=$O(^BQI(90507,REG,10,N)) Q:'N  D
  1.  .. S X=$P(^BQI(90507,REG,10,N,0),U,1)
  1.  .. S IEN=N_","_REG_","
  1.  .. I $P(^BQI(90507,REG,10,N,0),U,5)="T" S VAL=$$STXPT(X,"L")
  1.  .. E  S VAL=$$STXPT(X,"N")
  1.  .. S BQIUPD(90507.01,IEN,.02)=VAL
  1.  . I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  . ;
  1.  . S RP=0
  1.  . F  S RP=$O(^BQI(90507,REG,20,RP)) Q:'RP  D
  1.  .. S N=0
  1.  .. F  S N=$O(^BQI(90507,REG,20,RP,10,N)) Q:'N  D
  1.  ... S X=$P(^BQI(90507,REG,20,RP,10,N,0),U,1)
  1.  ... S IEN=N_","_RP_","_REG_","
  1.  ... S TIEN=$O(^BQI(90507,REG,10,"B",X,""))
  1.  ... I $P(^BQI(90507,REG,10,TIEN,0),U,5)="T" S VAL=$$STXPT(X,"L")
  1.  ... E  S VAL=$$STXPT(X,"N")
  1.  ... S BQIUPD(90507.03,IEN,.02)=VAL
  1.  . I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1.  ;
  1.  ; Set BTPWRPC into BQIRPC
  1.  NEW IEN,DA,X,DIC,Y
  1.  S DA(1)=$$FIND1^DIC(19,"","B","BQIRPC","","","ERROR"),DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="LMNZ"
  1.  S X="BTPWRPC"
  1.  D ^DIC I +Y<1 K DO,DD D FILE^DICN
  1.  Q
  1.  ;
  1. STXPT(TXNM,TYP) ;  Set taxonomy pointer
  1.  ;
  1.  ;Input
  1.  ;  TXNM - Taxonomy name
  1.  ;  TYP  - Taxonomy Type (L = LAB, N = Non Lab)
  1.  NEW IEN,SIEN,DA,IENS,BQUPD,VALUE,GLB
  1.  S VALUE=""
  1.  I TYP="L" D
  1.  . S IEN=$O(^ATXLAB("B",TXNM,"")),GLB="ATXLAB("
  1.  . I IEN="" S TYP="N"
  1.  I TYP="N" S IEN=$O(^ATXAX("B",TXNM,"")),GLB="ATXAX("
  1.  I IEN="" S VALUE="@"
  1.  I IEN'="" S VALUE=IEN_";"_GLB
  1.  Q VALUE
  1.  ;
  1. ARV ;
  1.  ;;0|BQIHSTA^^ARV Stability^^90451.01^45^^T02048BQIHSTA^^^^^^^^1~3|6^^^D^12~5|
  1.  ;;0|BKMHSCOM^^ARV Stability Comment^^90451.145^20^^T01024BKMHSCOM^^^^^^^^1~1|S VAL=$$HIVM^BQIRGUTL(DFN,45,FLD,4) I VAL'=""!($G(MVALUE)'="") S VAL=$$HIVS^BQIRGUTL(VAL,MVALUE,"; ")~3|6^^^O^^^^D~5|
  1.  ;;0|BKMHSDT^^ARV Stability Date^^90451.145^.01^^D00015BKMHSDT^^^^^^^^1~1|~3|6^^^O^^^^D~5|
  1.  ;;0|BKMHSRG^^ARV Stability Regimen^^90451.145^.03^^T00030BKMHSRG^^^^^^^^1~1|S VAL=$$HIVM^BQIRGUTL(DFN,45,FLD,.03) I VAL'="" S VAL=$$HIVS^BQIRGUTL(VAL,MVALUE,"; ")~3|6^^^O^^^^D~5|
  1.  ;;0|BKMHSST^^ARV Stability Status^^90451.145^.02^^T00030BKMHSST^^^^^^^^1~1|S VAL=$$HIVM^BQIRGUTL(DFN,45,FLD,.02) I VAL'="" S VAL=$$HIVS^BQIRGUTL(VAL,MVALUE,"; ")~3|6^^^O^^^^D~5|
  1.  ;;0|BKMHSWHN^^ARV Stability Last Edited Date^^90451.145^.05^^D00030BKMHSWHN~1|S VAL=$P($$HIVM^BQIRGUTL(DFN,45,FLD,.05)," ",1,2) I VAL'="" S VAL=$$HIVS^BQIRGUTL(VAL,MVALUE,"; ")~3|6^^^O^^^^D~5|
  1.  ;;0|BKMHSWHO^^ARV Stability Last Edited By^^90451.145^.04^^T00035BKMHSWHO^^^^^^^^~1|S VAL=$$HIVM^BQIRGUTL(DFN,45,FLD,.04) I VAL'="" S VAL=$$HIVS^BQIRGUTL(VAL,MVALUE,"; "),MVALUE=$$STRIP^BQIRGUTL(MVALUE_VAL,"; "),VAL=""~3|6^^^O^^^^D~5|
  1.  ;;0|REMMETH^^Communication Preference^^9000001^4002^^T00010REMMETH~1|~3|1^^Demographics^O^35~5|
  1.  ;;0|PFLANG^^Preferred Language^^^^^T00050PFLANG~1|S VAL=$$PFLNG^BQIULPT(DFN)~3|1^^Demographics^O^36~5|
  1.  ;;0|ALGY^^Allergies^^^^^T01024ALGY^^^^^^^125~1|S VAL=$$ALG^BQIPTALG(DFN)~3|1^^Other Patient Data^O^37~5|
  1.  ;;