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

BQI11P3.m

Go to the documentation of this file. 
  1. BQI11P3 ;VNGT/HS/ALA-iCare Version 1.1 Patch 2 Post-Install ; 20 Jun 2008  10:14 AM
  1.  ;;1.1;ICARE MANAGEMENT SYSTEM;**3**;Jul 08, 2008
  1.  ;
  1. EN ;
  1.  ;
  1.  ; Clean up Elder Care bad records
  1.  NEW BJPCX
  1.  S BJPCX=0 F  S BJPCX=$O(^AUPNVELD(BJPCX)) Q:BJPCX'=+BJPCX  D
  1.  . I $P(^AUPNVELD(BJPCX,0),U,1)["""" D
  1.  .. S DA=BJPCX,DIE="^AUPNVELD(",DR=".01///IHS-1-865" D ^DIE K DA,DIE,DR
  1.  ; Add new BGP SMOKER CPTS and update BQI KNOWN CVD-1 PROCEDURES
  1.  D ^BQIHTX
  1.  ; Change BGP GPRA SMOKING DXS to BGP SMOKER ONLY DXS
  1.  S BQIDA=$$SPM^BQIGPUTL()
  1.  NEW DA,IENS,TIEN
  1.  S DA(1)=BQIDA,DA=18,IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90508.03,IENS,.01)="BGP SMOKER ONLY DXS"
  1.  S TIEN=$O(^ATXAX("B","BGP SMOKER ONLY DXS",""))
  1.  S BQIUPD(90508.03,IENS,.02)=TIEN_";ATXAX("
  1.  S BQIUPD(90508.03,IENS,.06)="@"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  NEW DA,DIK,DIC,X,DLAYGO,IENS,BQIUPD,TIEN
  1.  S DA(1)=$O(^BQI(90508,0)),DIK="^BQI(90508,"_DA(1)_",10,"
  1.  S DA=45 F  S DA=$O(^BQI(90508,DA(1),10,DA)) Q:'DA  D ^DIK
  1.  S DA(1)=$O(^BQI(90508,0))
  1.  S DIC(0)="L",DIC="^BQI(90508,"_DA(1)_",10,",X="BGP SMOKER CPTS",DLAYGO=90508.03
  1.  K DD,DO
  1.  D FILE^DICN
  1.  S DA=+Y I DA=-1 S DA=46
  1.  S IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90508.03,IENS,.01)="BGP SMOKER CPTS"
  1.  S TIEN=$O(^ATXAX("B","BGP SMOKER CPTS",""))
  1.  S BQIUPD(90508.03,IENS,.06)="BQIHTX"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  S BQIUPD(90508.03,IENS,.02)=TIEN_";ATXAX("
  1.  S BQIUPD(90508.03,IENS,.03)=2
  1.  S BQIUPD(90508.03,IENS,.05)="C"
  1.  D FILE^DIE("I","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  ; Fix Lab entry in 90506.3
  1.  NEW VIEN,DA,IENS,DIEN
  1.  S VIEN=$O(^BQI(90506.3,"B","Lab","")),DA(1)=VIEN
  1.  S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Site/Specimen",""))
  1.  S DA=DIEN,IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90506.31,IENS,.05)=7,BQIUPD(90506.31,IENS,.08)="@"
  1.  S BQIUPD(90506.31,IENS,.09)="@",BQIUPD(90506.31,IENS,.1)="@"
  1.  S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Result",""))
  1.  S DA=DIEN,IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90506.31,IENS,.05)=5
  1.  S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Units",""))
  1.  S DA=DIEN,IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90506.31,IENS,.05)=21
  1.  S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Range",""))
  1.  S DA=DIEN,IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90506.31,IENS,.05)=9
  1.  S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Normal/Abnormal",""))
  1.  S DA=DIEN,IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90506.31,IENS,.05)=6
  1.  S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Ordering Physician",""))
  1.  S DA=DIEN,IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90506.31,IENS,.04)="H"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  ; Fix Patient Education entry in 90506.3
  1.  NEW VIEN,DA,IENS,DIEN
  1.  S VIEN=$O(^BQI(90506.3,"B","Patient Education","")),DA(1)=VIEN
  1.  S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Provider",""))
  1.  S DA=DIEN,IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90506.31,IENS,2.01)="APCDTPRO",BQIUPD(90506.31,IENS,2.02)="EPRV(APCDTPRO)"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  ; Update alternate help text in 90506.3
  1.  NEW VIEN,DA,IENS
  1.  S VIEN=$O(^BQI(90506.3,"B","PCC Visit","")),DA(1)=VIEN
  1.  S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Date",""))
  1.  S DA=DIEN,IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90506.31,IENS,3.06)="Enter date of visit.  Must be between patient's DOB and today."
  1.  S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Outside Location",""))
  1.  S DA=DIEN,IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90506.31,IENS,3.06)="Enter the name of the outside facility where the visit occurred, e.g. Smith Nursing Home."
  1.  S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Outside Provider Name",""))
  1.  S DA=DIEN,IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90506.31,IENS,3.06)="Enter the name of the patient's provider for this visit."
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  ; Update generated panel description for those sites that may
  1.  ; have encountered an error in the original install due to
  1.  ; deleted QMan templates
  1.  D PDSC
  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.  Q
  1.  ;
  1. PRE ; Pre-install
  1.  NEW DIK,DA
  1.  S DIK="^BQI(90506.2,"
  1.  S DA=0 F  S DA=$O(^BQI(90506.2,DA)) Q:'DA  D ^DIK
  1.  Q
  1.  ;
  1. PDSC ; 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