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

BQI11PST.m

Go to the documentation of this file.
  1. BQI11PST ;PRXM/HC/ALA-Version 1.1 Post-Install ; 30 May 2007 5:19 PM
  1. ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1. ;
  1. EN ;EP
  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. S BQIUPD(90508,BQIDA_",",1)=$G(^XTMP("BQICARE","VISIT"))
  1. D FILE^DIE("","BQIUPD","ERROR")
  1. K BQIUPD
  1. ;
  1. ; Check for missing node zeros from NPT^BQITASK error
  1. S BQIN=0
  1. F S BQIN=$O(^BQIPAT(BQIN)) Q:'BQIN I $G(^BQIPAT(BQIN,0))="" S ^BQIPAT(BQIN,0)=BQIN,^BQIPAT("B",BQIN,BQIN)=""
  1. ;
  1. ; if iCare hasn't been installed before, set up initial information
  1. I $G(^XTMP("BQICARE",0))=0 D
  1. . ; Reset all date started/stopped values
  1. . F FD=.02,.03,.04,.05,.06,.07,.15,.16,1.01,1.02,1.03,1.04,1.05,1.06,1.07,1.08 S BQIUPD(90508,BQIDA_",",FD)="@"
  1. . D FILE^DIE("","BQIUPD","ERROR")
  1. . ; Set the last visit IEN
  1. . S BQIUPD(90508,BQIDA_",",1)=$O(^AUPNVSIT("A"),-1)
  1. . D FILE^DIE("","BQIUPD","ERROR")
  1. . K BQIUPD
  1. . ; Set up the taxonomies
  1. . D LTAX
  1. . ; Set up the 'ALL REMINDERS' list
  1. . D REM
  1. . ; Set up initial program to populate BQIPAT
  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,^XTMP("BQICARE")
  1. ;
  1. ; For Version 1.1
  1. D LTAX
  1. ; Add Taxonomy short descriptions
  1. NEW TEXT,TAX,DESC,TIEN,BQIUPD,ERROR
  1. F I=1:1 S TEXT=$P($T(TDSC+I),";;",1) Q:TEXT="" D
  1. . S TAX=$P(TEXT,U,1),DESC=$P(TEXT,U,2)
  1. . S TIEN=$$FIND1^DIC(9002226,"","B",TAX,"","","ERROR")
  1. . S BQIUPD(9002226,TIEN_",",.02)=DESC
  1. D FILE^DIE("","BQIUPD","ERROR")
  1. ;
  1. ; For existing sites
  1. I $O(^BQICARE(0))'="" D
  1. . D PDSC
  1. . ; Check for new CRS version
  1. . NEW BQIH,OBQIYR,NBQIYR
  1. . S BQIH=$$SPM^BQIGPUTL()
  1. . S OBQIYR=$$GET1^DIQ(90508,BQIH_",",2,"E")
  1. . D GCHK^BQIGPUPD(1)
  1. . S BQIH=$$SPM^BQIGPUTL()
  1. . S NBQIYR=$$GET1^DIQ(90508,BQIH_",",2,"E")
  1. . I OBQIYR=NBQIYR Q
  1. . ; Set up TaskMan to reset GPRA data
  1. . NEW ZTDESC,ZTRTN,ZTIO,JBNOW,ZTDTH,ZTSK
  1. . S ZTDESC="ICARE RESET DATA",ZTRTN="FGP^BQI11PST",ZTIO=""
  1. . S JBNOW=$$NOW^XLFDT()
  1. . S ZTDTH=$$FMADD^XLFDT(JBNOW,,,3)
  1. . D ^%ZTLOAD
  1. ;
  1. ;Set the version number
  1. S DA=$O(^BQI(90508,0))
  1. S BQIUPD(90508,DA_",",.08)="1.1.29"
  1. S BQIUPD(90508,DA_",",.09)="1.1T29"
  1. D FILE^DIE("","BQIUPD","ERROR")
  1. K BQIUPD
  1. ;
  1. ; Update the reminders view entries
  1. D UPV
  1. ;
  1. ; Set up to initialize reminders
  1. S ZTDESC="ICARE REMINDERS CALCULATE",ZTRTN="EN^BQITASK1",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. K ZTDESC,ZTRTN,ZTIO,JBNOW,JBDATE,ZTDTH,ZTSK
  1. ;
  1. ; Check if patch 1 was installed, if not, need to kill CVD tags
  1. ; and recalculate
  1. I '$$PATCH^XPDUTL("BQI*1.0*1") D
  1. . NEW DA,DIK,DFN
  1. . S DFN=0
  1. . F S DFN=$O(^BQIPAT(DFN)) Q:'DFN D
  1. .. S DA(1)=DFN,DA=6,DIK="^BQIPAT("_DA(1)_",20,"
  1. .. D ^DIK
  1. . ;
  1. . ; Set up task to run to regenerate Dx Categories
  1. . NEW ZTDESC,ZTRTN,ZTIO,JBNOW,JBDATE,ZTDTH,ZTSK
  1. . S ZTDESC="ICARE DX CAT PROGRAM",ZTRTN="DXC^BQITASK2",ZTIO=""
  1. . S JBNOW=$$NOW^XLFDT()
  1. . S JBDATE=$S($E($P(JBNOW,".",2),1,2)<18:DT,1:$$FMADD^XLFDT(DT,+1))
  1. . S ZTDTH=JBDATE_".18"
  1. . D ^%ZTLOAD
  1. . K ZTDESC,ZTRTN,ZTIO,JBNOW,JBDATE,ZTDTH,ZTSK
  1. ;
  1. ; Set up TaskMan jobs, if they haven't already been set up
  1. D ^BQISCHED
  1. ;
  1. ML ;EP - Check for bad pointers in Location file
  1. NEW LOC,AREA,SU,CT,XMY,XMZ,XMFROM
  1. K ^TMP("BQIMAIL",$J)
  1. S LOC=0,CT=0
  1. F S LOC=$O(^AUTTLOC(LOC)) Q:'LOC D
  1. . I $P(^AUTTLOC(LOC,0),"^",21)'="" Q
  1. . S AREA=$P(^AUTTLOC(LOC,0),"^",4)
  1. . S SU=$P(^AUTTLOC(LOC,0),"^",5)
  1. . I SU'="",$$GET1^DIQ(9999999.22,SU_",",.01,"E")="" D
  1. .. S CT=CT+1,^TMP("BQIMAIL",$J,CT,0)="Location: "_$P(^DIC(4,LOC,0),U,1)_" has a bad Service Unit pointer."
  1. . I AREA'="",$$GET1^DIQ(9999999.21,AREA_",",.01,"E")="" D
  1. .. S CT=CT+1,^TMP("BQIMAIL",$J,CT,0)="Location: "_$P(^DIC(4,LOC,0),U,1)_" has a bad Area pointer."
  1. ;
  1. I $D(^TMP("BQIMAIL",$J))>0 D
  1. . S CT=CT+1,^TMP("BQIMAIL",$J,CT,0)=" "
  1. . S XMSUB="iCare Install Problem",XMFROM="iCare Install"
  1. . S XMTEXT="^TMP(""BQIMAIL"",$J,"
  1. . I $G(DUZ)'="" S XMDUZ=DUZ,XMY(DUZ)=""
  1. . I $G(DUZ)="" S XMDUZ="iCare Install"
  1. . S XMY(DUZ)=""
  1. . I '$D(XMY) S XMY(.5)=""
  1. . D ^XMD
  1. . K XMSUB,XMTEXT,XMY,XMDUZ,XMZ,XMFROM
  1. Q
  1. ;
  1. FGP ;EP - Fix the GPRA layouts in existing panels
  1. NEW OWNR,PLIEN,LIEN,VAL,NVAL,SHR,DFN
  1. S OWNR=0
  1. F S OWNR=$O(^BQICARE(OWNR)) Q:'OWNR D
  1. . S PLIEN=0
  1. . F S PLIEN=$O(^BQICARE(OWNR,1,PLIEN)) Q:'PLIEN D
  1. .. NEW DA,IENS,BQIYR,BQIH,BQIY
  1. .. S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
  1. .. S BQIYR=$$GET1^DIQ(90505.01,IENS,3.3,"E")
  1. .. S BQIH=$$SPM^BQIGPUTL()
  1. .. I BQIYR="" S BQIYR=$$GET1^DIQ(90508,BQIH_",",2,"E")
  1. .. S LIEN=0
  1. .. F S LIEN=$O(^BQICARE(OWNR,1,PLIEN,25,LIEN)) Q:'LIEN D
  1. ... S VAL=$P(^BQICARE(OWNR,1,PLIEN,25,LIEN,0),U,1)
  1. ... I VAL'?.N Q
  1. ... S NVAL=BQIYR_"_"_VAL
  1. ... S DA(2)=OWNR,DA(1)=PLIEN,DA=LIEN,IENS=$$IENS^DILF(.DA)
  1. ... S BQIUPD(90505.125,IENS,.01)=NVAL
  1. .. D FILE^DIE("","BQIUPD","ERROR")
  1. .. K BQIUPD
  1. .. ;
  1. .. ; Fix existing GPRA layouts for Share users
  1. .. S SHR=0
  1. .. F S SHR=$O(^BQICARE(OWNR,1,PLIEN,30,SHR)) Q:'SHR D
  1. ... S LIEN=0
  1. ... F S LIEN=$O(^BQICARE(OWNR,1,PLIEN,30,SHR,25,LIEN)) Q:'LIEN D
  1. .... S VAL=$P(^BQICARE(OWNR,1,PLIEN,30,SHR,25,LIEN,0),U,1)
  1. .... I VAL'?.N Q
  1. .... S NVAL=BQIYR_"_"_VAL
  1. .... S DA(3)=OWNR,DA(2)=PLIEN,DA(1)=SHR,DA=LIEN,IENS=$$IENS^DILF(.DA)
  1. .... S BQIUPD(90505.325,IENS,.01)=NVAL
  1. ... D FILE^DIE("","BQIUPD","ERROR")
  1. ... K BQIUPD
  1. ;
  1. ; Fix patient's GPRA references
  1. S DFN=0
  1. F S DFN=$O(^BQIPAT(DFN)) Q:'DFN D
  1. . S BQIYR=$P(^BQIPAT(DFN,0),U,2)
  1. . I BQIYR="" D
  1. .. S BQIH=$$SPM^BQIGPUTL()
  1. .. S BQIYR=$$GET1^DIQ(90508,BQIH_",",2,"E")
  1. . S IEN=0
  1. . F S IEN=$O(^BQIPAT(DFN,30,IEN)) Q:'IEN D
  1. .. S VAL=$P(^BQIPAT(DFN,30,IEN,0),U,1)
  1. .. I VAL'?.N Q
  1. .. S DA(1)=DFN,DA=IEN,IENS=$$IENS^DILF(.DA)
  1. .. S BQIUPD(90507.53,IENS,.01)="@"
  1. . D FILE^DIE("","BQIUPD","ERROR")
  1. . K BQIUPD
  1. ;
  1. Q
  1. ;
  1. PDSC ;EP - Load revised generated descriptions for all panels
  1. ;
  1. NEW OWNR,PLIEN
  1. S OWNR=0
  1. F S OWNR=$O(^BQICARE(OWNR)) Q:'OWNR D
  1. . S PLIEN=0
  1. . F S PLIEN=$O(^BQICARE(OWNR,1,PLIEN)) Q:'PLIEN D
  1. .. NEW DA,IENS
  1. .. S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
  1. .. K DESC
  1. .. D PEN^BQIPLDSC(OWNR,PLIEN,.DESC)
  1. .. D WP^DIE(90505.01,IENS,5,"","DESC")
  1. .. K DESC,BMXSEC
  1. Q
  1. ;
  1. UPV ;EP - Update the pointers for reminder views
  1. NEW IEN,NAME,CODE,HIEN,HTAG,BQIUPD,IMN,TAG,NCODE,INAME
  1. S IEN=""
  1. RM ; EP
  1. S IEN=$O(^BQI(90506.1,"AC","R",IEN)) G EXT:IEN=""
  1. S NAME=$P(^BQI(90506.1,IEN,0),"^",3)
  1. S CODE=$P(^BQI(90506.1,IEN,0),"^",1)
  1. S HIEN=$P(CODE,"_",2),HTAG=$P(CODE,"_",1)
  1. ;
  1. ; If it's an immunization
  1. I HTAG="AUTTIMM" D IMM G RM
  1. ; If it's not an immunization
  1. S IMN=$O(^APCHSURV("B",NAME,"")) I IMN="" G RM
  1. S TAG=$P($P(^APCHSURV(IMN,0),"^",2),";",1)
  1. I HIEN=IMN,HTAG=TAG D G RM
  1. . I $P(^APCHSURV(IMN,0),"^",3)'=1 D INA
  1. S NCODE=HTAG_"_"_IMN
  1. S BQIUPD(90506.1,IEN_",",.01)=NCODE
  1. I $P(^APCHSURV(IMN,0),"^",3)'=1 D INA
  1. G RM
  1. ;
  1. INA ;EP - Inactivate
  1. S BQIUPD(90506.1,IEN_",",.1)=1
  1. S BQIUPD(90506.1,IEN_",",.11)=DT
  1. Q
  1. ;
  1. EXT ;EP - Store updates
  1. I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
  1. ;D CHK^BQIRMDR
  1. Q
  1. ;
  1. IMM ;EP - Fix Immunization Reminders
  1. S INAME=$P($G(^AUTTIMM(HIEN,0)),"^",2)
  1. I INAME=NAME Q
  1. S IMN=$O(^AUTTIMM("AC",NAME,"")) Q:IMN=""
  1. S NCODE=HTAG_"_"_IMN
  1. S BQIUPD(90506.1,IEN_",",.01)=NCODE
  1. I $G(BQIUPD(90506.1,IEN_",",.1))=1 K BQIUPD(90506.1,IEN_",",.1),BQIUPD(90506.1,IEN_",",.11)
  1. Q
  1. ;
  1. REM ;EP - 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. . K DO,DD 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. . K DO,DD 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. . K DO,DD 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 ;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)) 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 ;EP - 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) I PRGM="^" Q
  1. . D @PRGM
  1. . S X=$P(^BQI(90508,BQIDA,10,IEN,0),U,1)
  1. . D STXPT(X,"N")
  1. ;
  1. JRN ; EP - 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) ; EP - 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. ;;
  1. ;
  1. TDSC ; Fix Taxonomy Descriptions
  1. ;;BQI KNOWN CVD-1 CPTS^1 only identifies Known CVD
  1. ;;BQI KNOWN CVD-MULT CPTS^Multiple identify Known CVD
  1. ;;BQI HYPERLIPIDEMIA DXS^Hyperlipidemia Dxs
  1. ;;BQI IHD DXS^Ischemic Heart Disease Dxs
  1. ;;BQI KNOWN CVD-1 DXS^1 only identifies Known CVD
  1. ;;BQI KNOWN CVD-MULT DXS^Multiple identify Known CVD
  1. ;;BQI KNOWN CVD-1 PROCEDURES^1 only identifies Known CVD
  1. ;;BQI KNOWN CVD-MULT PROCEDURES^Multiple identify Known CVD
  1. ;;BQI STATIN NDC^Statin med NDCs
  1. ;;BQI STATIN MEDS CLASS^Statin med Class Codes
  1. ;;