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

BQI23P2.m

Go to the documentation of this file. 
  1. BQI23P2 ;GDIT/HS/ALA-Patch 2 Installation ; 28 Dec 2012  8:13 AM
  1.  ;;2.3;ICARE MANAGEMENT SYSTEM;**2**;Apr 18, 2012;Build 14
  1.  ;
  1. PRE ;EP
  1.  NEW DA,DIK
  1.  S DA=0,DIK="^BQI(90509.9,"
  1.  F  S DA=$O(^BQI(90509.9,DA)) Q:'DA  D ^DIK
  1.  Q
  1.  ;
  1. POS ;EP
  1.  ;
  1.  ; Fix Goal Setting
  1.  NEW TPRN,TPRD,GPRN,GPRD,DEN,FAC,YEAR,BQDATE
  1.  S YEAR=$$GET1^DIQ(90508,1_",",2,"E")
  1.  S FAC=$$HME^BQIGPUTL()
  1.  S TPRN=$O(^BQIFAC(FAC,30,"B","IPC_TOTP",""))
  1.  S GPRN=$O(^BQIFAC(FAC,30,"B",YEAR_"_2452",""))
  1.  I GPRN'="",TPRN'="" D
  1.  . S BQDATE=""
  1.  . F  S BQDATE=$O(^BQIFAC(FAC,30,GPRN,1,"B",BQDATE)) Q:BQDATE=""  D
  1.  .. S TPRD=$O(^BQIFAC(FAC,30,TPRN,1,"B",BQDATE,"")) I TPRD="" Q
  1.  .. S GPRD=$O(^BQIFAC(FAC,30,GPRN,1,"B",BQDATE,"")) I GPRD="" Q
  1.  .. S DEN=$P(^BQIFAC(FAC,30,TPRN,1,TPRD,0),U,2)
  1.  .. S $P(^BQIFAC(FAC,30,GPRN,1,GPRD,0),U,2)=DEN
  1.  ;
  1.  ; fix A1C
  1.  I $P($G(^BQI(90508,1,"GPRA")),U,1)=2012 D
  1.  . S ^BQI(90508,1,22,2,1,15,2,1,0)="2012_2633"
  1.  . K ^BQI(90508,1,22,2,1,15,2,"B")
  1.  . S ^BQI(90508,1,22,2,1,15,2,"B","2012_2633",1)=""
  1.  I $P($G(^BQI(90508,1,"GPRA")),U,1)=2013 D
  1.  . S ^BQI(90508,1,22,2,1,15,2,1,0)="2013_2633"
  1.  . K ^BQI(90508,1,22,2,1,15,2,"B")
  1.  . S ^BQI(90508,1,22,2,1,15,2,"B","2013_2633",1)=""
  1.  S $P(^BQI(90508,1,22,2,1,16,0),U,4)="Alcohol Screen Females 15-44"
  1.  ;
  1.  NEW TAX,DIK,DA
  1.  F TAX="BQI SYPH DARK FIELD TEST LOINC","BQI SYPHILIS QUAL TEST LOINC","BQI SYPHILIS QUANT TEST LOINC" D
  1.  . S DIK="^ATXAX(",DA=$O(^ATXAX("B",TAX,"")) I DA'="" D ^DIK
  1.  F TAX="BQI SYPH DARK FIELD TEST TAX","BQI SYPHILIS QUAL TEST TAX","BQI SYPHILIS QUANT TEST TAX" D
  1.  . S DIK="^ATXLAB(",DA=$O(^ATXLAB("B",TAX,"")) I DA'="" D ^DIK
  1.  ;
  1. LTAX ;EP  Add Lab Taxonomies to ^ATXLAB
  1.  NEW X,DIC,DLAYGO,DA,DR,DIE,Y,LTAX,D0,DINUM
  1.  S DIC="^ATXLAB(",DIC(0)="L",DLAYGO=9002228
  1.  ; Loop through the Taxonomies
  1.  D LDLAB(.LTAX)
  1.  F BJ=1:1 Q:'$D(LTAX(BJ))  S X=LTAX(BJ) D
  1.  . I $D(^ATXLAB("B",X)) Q  ; Skip pre-existing Lab taxonomies
  1.  . D ^DIC S DA=+Y
  1.  . I DA<1 Q
  1.  . S BQTXUP(9002228,DA_",",.02)=$P(X," ",2,999)
  1.  . S BQTXUP(9002228,DA_",",.05)=DUZ
  1.  . S BQTXUP(9002228,DA_",",.06)=DT
  1.  . S BQTXUP(9002228,DA_",",.09)=60
  1.  . D FILE^DIE("I","BQTXUP")
  1.  . S BQTXUP(9002228,DA_",",.08)="B"
  1.  . D FILE^DIE("E","BQTXUP")
  1.  ;
  1.  K DA,BJ,BQTXUP,DIC,DLAYGO,DINUM,D0,DR,X,Y
  1.  ;
  1. TAX ;EP  Set up the taxonomies
  1.  D ^BQIHTX
  1.  ;
  1.  ; Remove LOINC code
  1.  NEW TXN
  1.  S TXN=$O(^ATXAX("B","BQI HIV ID SPEC CONFIRM LOINC",""))
  1.  I TXN'="" D
  1.  . NEW DA,DIK
  1.  . S DA=$O(^ATXAX(TXN,21,"B","13499-9","")) I DA="" Q
  1.  . S DA(1)=TXN,DIK="^ATXAX("_DA(1)_",21," D ^DIK
  1.  ;
  1. GLS ;EP Update glossary
  1.  NEW GN,GNM,GSN,BQIUPD
  1.  S GN=0
  1.  F  S GN=$O(^BQI(90509.9,GN)) Q:'GN  D
  1.  . S GNM=$P(^BQI(90509.9,GN,0),U,1)
  1.  . S GSN=$O(^BQI(90508.2,"B",GNM,"")) Q:GSN=""
  1.  . S BQIUPD(90508.2,GSN_",",1)="@"
  1.  . D FILE^DIE("","BQIUPD","ERROR")
  1.  . M ^BQI(90508.2,GSN,1)=^BQI(90509.9,GN,1)
  1.  Q
  1.  ;
  1. LDLAB(ARRAY) ;EP;Load site-populated Lab tests
  1.  NEW I,TEXT
  1.  F I=1:1 S TEXT=$P($T(LAB+I),";;",2) Q:TEXT=""  S ARRAY(I)=TEXT
  1.  Q
  1.  ;
  1. LAB ;EP;LAB TESTS (SITE-POPULATED)
  1.  ;;BQI SYPHILIS TP-AB TEST TAX
  1.  ;;BQI SYPHILIS REAGIN TEST TAX
  1.  Q