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

BQI1POST.m

Go to the documentation of this file.
  1. BQI1POST ;PRXM/HC/DLS - BQI Post Installation Routine ; 23 Mar 2006 4:10 PM
  1. ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1. ;
  1. ;
  1. ;**Program Description**
  1. ; This is the post-installation program to set up values for the
  1. ; iCARE System
  1. ;
  1. EN ; EP - BQI Post Install
  1. ;
  1. ; Set up the parameters file with the default location
  1. NEW BGPHOME,BGPHN,BQIDA,FD,BGDATA,IDIN
  1. S BGPHN=$O(^BGPSITE(0)) S:BGPHN BGPHOME=$P($G(^BGPSITE(BGPHN,0)),U,1)
  1. Q:$G(BGPHOME)=""
  1. S BQIDA=1
  1. S BQIUPD(90508,BQIDA_",",.01)=BGPHOME
  1. F FD=.02,.03,.04,.05,.06,.07,1.01,1.02 S BQIUPD(90508,BQIDA_",",FD)="@"
  1. D FILE^DIE("","BQIUPD","ERROR")
  1. ;
  1. ; Add the GPRA information to the site parameters if 2007 has been installed
  1. ; removed 3/15/2007 ALA
  1. ;I $$VERSION^XPDUTL("BGP")="7.0" D
  1. ;. D EN^BQIGPUPD("2007","90530.01","90530.02","BGP7D10",1)
  1. ;
  1. VIS ; Set the last visit IEN
  1. S BQIUPD(90508,BQIDA_",",1)=$O(^AUPNVSIT("A"),-1)
  1. D FILE^DIE("","BQIUPD","ERROR")
  1. ;
  1. REM ; Set up the 'ALL REMINDERS' Patient Health Summary Definition
  1. I '$$FIND1^DIC(9001015,"","","ALL REMINDERS","B","","") D
  1. . N X,Y,DA,DR,DIC,DLAYGO,CMPNDX,REMNDX
  1. . ;
  1. . ; Create top level for 'ALL REMINDERS' Hlth Summary
  1. . S X="ALL REMINDERS",DIC(0)="LZ",DLAYGO=9001015,DIC="^APCHSCTL("
  1. . D FILE^DICN
  1. . ;
  1. . ; Build Sort Order Sub-File
  1. . N DIC,DA,DIE,DR,X,BQIUPD
  1. . S DLAYGO=9001015.01
  1. . S (DA(1),REMNDX)=+Y,DA=10,DIC(0)="LZ",DIC="^APCHSCTL("_DA(1)_",1,"
  1. . D FILE^DICN
  1. . ;
  1. . ; Add Component IEN for Reminders (from 9001016) to Hlth Summary
  1. . S CMPNDX=$$FIND1^DIC(9001016,"","","HEALTH MAINTENANCE REMINDERS","B","","")
  1. . Q:'CMPNDX
  1. . S DA(1)=REMNDX,DA=10,DIE=DIC
  1. . S DR=".01///"_DA_";1////"_CMPNDX
  1. . D ^DIE
  1. . ;
  1. . ; Build Health Summary nodes.
  1. . N DIC,DA,NDX,NDX2,RMNDR,X,Y,DR
  1. . S DA(1)=REMNDX,DLAYGO=9001015.06,DIC(0)="LZ"
  1. . S DIC="^APCHSCTL("_DA(1)_",5,"
  1. . D FILE^DICN
  1. . S NDX=""
  1. . F S NDX=$O(^APCHSURV("AC",NDX)) Q:NDX="" D
  1. .. S RMNDR=""
  1. .. F S RMNDR=$O(^APCHSURV("AC",NDX,RMNDR)) Q:RMNDR="" D
  1. ... I $$GET1^DIQ(9001018,RMNDR,.03,"I")'="D" D
  1. .... S (DA,NDX2)=(NDX*100)+RMNDR,DIE=DIC
  1. .... S DR=".01///"_NDX2_";1////"_RMNDR
  1. .... D ^DIE
  1. .... Q
  1. ;
  1. LTAX ; 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 as stored in routine BKMVTAX4.
  1. D LDLAB(.LTAX)
  1. F BJ=1:1 Q:'$D(LTAX(BJ)) S X=LTAX(BJ) D
  1. . I $D(^ATXLAB("B",X)) D STXPT(X,"L") 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. . D STXPT(X,"L")
  1. ;
  1. K DA,BJ,BQTXUP,DIC,DLAYGO,DINUM,D0,DR,X,Y
  1. ;
  1. TAX ; Set up the taxonomies
  1. ;
  1. D ^BQITX
  1. D ^BQIATX
  1. ;
  1. ; Reset the variable pointer values for the taxonomies
  1. S N=0
  1. F S N=$O(^BQI(90508,BQIDA,10,N)) Q:'N D
  1. . S X=$P(^BQI(90508,BQIDA,10,N,0),U,1)
  1. . I $P(^BQI(90508,BQIDA,10,N,0),U,3)=5 D STXPT(X,"L") Q
  1. . D STXPT(X,"N")
  1. ;
  1. ; Reindex the site parameter file
  1. NEW DIK
  1. S DIK="^BQI(90508," D IXALL^DIK
  1. ;
  1. ; Check taxonomies
  1. NEW IEN,PRGM,X
  1. S IEN=0
  1. F S IEN=$O(^BQI(90508,BQIDA,10,IEN)) Q:'IEN D
  1. . I $P(^BQI(90508,BQIDA,10,IEN,0),U,2)'="" Q
  1. . I $P(^BQI(90508,BQIDA,10,IEN,0),U,3)=5 Q
  1. . S PRGM=U_$P(^BQI(90508,BQIDA,10,IEN,0),U,6)
  1. . D @PRGM
  1. . S X=$P(^BQI(90508,BQIDA,10,IEN,0),U,1)
  1. . D STXPT(X,"N")
  1. ;
  1. ; Set up tagging program
  1. S ZTDESC="ICARE TAG PROGRAM",ZTRTN="ENT^BQI1POJB",ZTIO=""
  1. S JBNOW=$$NOW^XLFDT()
  1. S JBDATE=$S($E($P(JBNOW,".",2),1,2)<20:DT,1:$$FMADD^XLFDT(DT,+1))
  1. S ZTDTH=JBDATE_".20"
  1. D ^%ZTLOAD
  1. NEW DA,IENS
  1. S DA=BQIDA,IENS=$$IENS^DILF(.DA)
  1. S BQIUPD(90508,IENS,.1)=ZTSK
  1. D FILE^DIE("","BQIUPD","ERROR")
  1. ;
  1. K ZTDESC,ZTRTN,ZTIO,JBNOW,JBDATE,ZTDTH,ZTSK,BQIGDA,N,ERROR
  1. K BQIINDG,BQIDA
  1. ;
  1. JRN ; Turn off journaling for BQIPAT
  1. NEW %,DIR
  1. S %=$$NOJOURN^ZIBGCHAR("BQIPAT")
  1. I % D
  1. . W !!,"Attempt to turn off journaling for global ^BQIPAT failed because "
  1. . W !?5,$$ERR^ZIBGCHAR(%)
  1. . W !,"Please notify the OIT Help Desk for assistance."
  1. . S DIR(0)="E" D ^DIR
  1. Q
  1. ;
  1. STXPT(TXNM,TYP) ; Set taxonomy pointer into Site Parameter file
  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. 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. S SIEN=$O(^BQI(90508,BQIDA,10,"B",TXNM,""))
  1. S DA(1)=BQIDA,DA=SIEN,IENS=$$IENS^DILF(.DA)
  1. S BQUPD(90508.03,IENS,.02)=VALUE
  1. D FILE^DIE("","BQUPD","ERROR")
  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. ;;BGP GPRA ESTIMATED GFR TAX
  1. ;;DM AUDIT CHOLESTEROL TAX
  1. ;;DM AUDIT CREATININE TAX
  1. ;;DM AUDIT HDL TAX
  1. ;;DM AUDIT LDL CHOLESTEROL TAX
  1. ;;DM AUDIT TRIGLYCERIDE TAX
  1. ;;DM AUDIT FASTING GLUCOSE TESTS
  1. ;;