BQI11P3 ;VNGT/HS/ALA-iCare Version 1.1 Patch 2 Post-Install ; 20 Jun 2008 10:14 AM
;;1.1;ICARE MANAGEMENT SYSTEM;**3**;Jul 08, 2008
;
EN ;
;
; Clean up Elder Care bad records
NEW BJPCX
S BJPCX=0 F S BJPCX=$O(^AUPNVELD(BJPCX)) Q:BJPCX'=+BJPCX D
. I $P(^AUPNVELD(BJPCX,0),U,1)["""" D
.. S DA=BJPCX,DIE="^AUPNVELD(",DR=".01///IHS-1-865" D ^DIE K DA,DIE,DR
; Add new BGP SMOKER CPTS and update BQI KNOWN CVD-1 PROCEDURES
D ^BQIHTX
; Change BGP GPRA SMOKING DXS to BGP SMOKER ONLY DXS
S BQIDA=$$SPM^BQIGPUTL()
NEW DA,IENS,TIEN
S DA(1)=BQIDA,DA=18,IENS=$$IENS^DILF(.DA)
S BQIUPD(90508.03,IENS,.01)="BGP SMOKER ONLY DXS"
S TIEN=$O(^ATXAX("B","BGP SMOKER ONLY DXS",""))
S BQIUPD(90508.03,IENS,.02)=TIEN_";ATXAX("
S BQIUPD(90508.03,IENS,.06)="@"
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
;
NEW DA,DIK,DIC,X,DLAYGO,IENS,BQIUPD,TIEN
S DA(1)=$O(^BQI(90508,0)),DIK="^BQI(90508,"_DA(1)_",10,"
S DA=45 F S DA=$O(^BQI(90508,DA(1),10,DA)) Q:'DA D ^DIK
S DA(1)=$O(^BQI(90508,0))
S DIC(0)="L",DIC="^BQI(90508,"_DA(1)_",10,",X="BGP SMOKER CPTS",DLAYGO=90508.03
K DD,DO
D FILE^DICN
S DA=+Y I DA=-1 S DA=46
S IENS=$$IENS^DILF(.DA)
S BQIUPD(90508.03,IENS,.01)="BGP SMOKER CPTS"
S TIEN=$O(^ATXAX("B","BGP SMOKER CPTS",""))
S BQIUPD(90508.03,IENS,.06)="BQIHTX"
D FILE^DIE("","BQIUPD","ERROR")
S BQIUPD(90508.03,IENS,.02)=TIEN_";ATXAX("
S BQIUPD(90508.03,IENS,.03)=2
S BQIUPD(90508.03,IENS,.05)="C"
D FILE^DIE("I","BQIUPD","ERROR")
K BQIUPD
;
; Fix Lab entry in 90506.3
NEW VIEN,DA,IENS,DIEN
S VIEN=$O(^BQI(90506.3,"B","Lab","")),DA(1)=VIEN
S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Site/Specimen",""))
S DA=DIEN,IENS=$$IENS^DILF(.DA)
S BQIUPD(90506.31,IENS,.05)=7,BQIUPD(90506.31,IENS,.08)="@"
S BQIUPD(90506.31,IENS,.09)="@",BQIUPD(90506.31,IENS,.1)="@"
S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Result",""))
S DA=DIEN,IENS=$$IENS^DILF(.DA)
S BQIUPD(90506.31,IENS,.05)=5
S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Units",""))
S DA=DIEN,IENS=$$IENS^DILF(.DA)
S BQIUPD(90506.31,IENS,.05)=21
S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Range",""))
S DA=DIEN,IENS=$$IENS^DILF(.DA)
S BQIUPD(90506.31,IENS,.05)=9
S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Normal/Abnormal",""))
S DA=DIEN,IENS=$$IENS^DILF(.DA)
S BQIUPD(90506.31,IENS,.05)=6
S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Ordering Physician",""))
S DA=DIEN,IENS=$$IENS^DILF(.DA)
S BQIUPD(90506.31,IENS,.04)="H"
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
;
; Fix Patient Education entry in 90506.3
NEW VIEN,DA,IENS,DIEN
S VIEN=$O(^BQI(90506.3,"B","Patient Education","")),DA(1)=VIEN
S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Provider",""))
S DA=DIEN,IENS=$$IENS^DILF(.DA)
S BQIUPD(90506.31,IENS,2.01)="APCDTPRO",BQIUPD(90506.31,IENS,2.02)="EPRV(APCDTPRO)"
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
;
; Update alternate help text in 90506.3
NEW VIEN,DA,IENS
S VIEN=$O(^BQI(90506.3,"B","PCC Visit","")),DA(1)=VIEN
S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Date",""))
S DA=DIEN,IENS=$$IENS^DILF(.DA)
S BQIUPD(90506.31,IENS,3.06)="Enter date of visit. Must be between patient's DOB and today."
S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Outside Location",""))
S DA=DIEN,IENS=$$IENS^DILF(.DA)
S BQIUPD(90506.31,IENS,3.06)="Enter the name of the outside facility where the visit occurred, e.g. Smith Nursing Home."
S DIEN=$O(^BQI(90506.3,VIEN,10,"B","Outside Provider Name",""))
S DA=DIEN,IENS=$$IENS^DILF(.DA)
S BQIUPD(90506.31,IENS,3.06)="Enter the name of the patient's provider for this visit."
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
;
; Update generated panel description for those sites that may
; have encountered an error in the original install due to
; deleted QMan templates
D PDSC
;
; Set up task to run to regenerate Dx Categories
NEW ZTDESC,ZTRTN,ZTIO,JBNOW,JBDATE,ZTDTH,ZTSK
S ZTDESC="ICARE DX CAT PROGRAM",ZTRTN="DXC^BQITASK2",ZTIO=""
S JBNOW=$$NOW^XLFDT()
S JBDATE=$S($E($P(JBNOW,".",2),1,2)<18:DT,1:$$FMADD^XLFDT(DT,+1))
S ZTDTH=JBDATE_".18"
D ^%ZTLOAD
K ZTDESC,ZTRTN,ZTIO,JBNOW,JBDATE,ZTDTH,ZTSK
Q
;
PRE ; Pre-install
NEW DIK,DA
S DIK="^BQI(90506.2,"
S DA=0 F S DA=$O(^BQI(90506.2,DA)) Q:'DA D ^DIK
Q
;
PDSC ; Load revised generated descriptions for all panels
;
NEW OWNR,PLIEN
S OWNR=0
F S OWNR=$O(^BQICARE(OWNR)) Q:'OWNR D
. S PLIEN=0
. F S PLIEN=$O(^BQICARE(OWNR,1,PLIEN)) Q:'PLIEN D
.. NEW DA,IENS
.. S DA(1)=OWNR,DA=PLIEN,IENS=$$IENS^DILF(.DA)
.. K DESC
.. D PEN^BQIPLDSC(OWNR,PLIEN,.DESC)
.. D WP^DIE(90505.01,IENS,5,"","DESC")
.. K DESC,BMXSEC
Q
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
+2 ;
EN ;
+1 ;
+2 ; Clean up Elder Care bad records
+3 NEW BJPCX
+4 SET BJPCX=0
FOR
SET BJPCX=$ORDER(^AUPNVELD(BJPCX))
IF BJPCX'=+BJPCX
QUIT
Begin DoDot:1
+5 IF $PIECE(^AUPNVELD(BJPCX,0),U,1)[""""
Begin DoDot:2
+6 SET DA=BJPCX
SET DIE="^AUPNVELD("
SET DR=".01///IHS-1-865"
DO ^DIE
KILL DA,DIE,DR
End DoDot:2
End DoDot:1
+7 ; Add new BGP SMOKER CPTS and update BQI KNOWN CVD-1 PROCEDURES
+8 DO ^BQIHTX
+9 ; Change BGP GPRA SMOKING DXS to BGP SMOKER ONLY DXS
+10 SET BQIDA=$$SPM^BQIGPUTL()
+11 NEW DA,IENS,TIEN
+12 SET DA(1)=BQIDA
SET DA=18
SET IENS=$$IENS^DILF(.DA)
+13 SET BQIUPD(90508.03,IENS,.01)="BGP SMOKER ONLY DXS"
+14 SET TIEN=$ORDER(^ATXAX("B","BGP SMOKER ONLY DXS",""))
+15 SET BQIUPD(90508.03,IENS,.02)=TIEN_";ATXAX("
+16 SET BQIUPD(90508.03,IENS,.06)="@"
+17 DO FILE^DIE("","BQIUPD","ERROR")
+18 KILL BQIUPD
+19 ;
+20 NEW DA,DIK,DIC,X,DLAYGO,IENS,BQIUPD,TIEN
+21 SET DA(1)=$ORDER(^BQI(90508,0))
SET DIK="^BQI(90508,"_DA(1)_",10,"
+22 SET DA=45
FOR
SET DA=$ORDER(^BQI(90508,DA(1),10,DA))
IF 'DA
QUIT
DO ^DIK
+23 SET DA(1)=$ORDER(^BQI(90508,0))
+24 SET DIC(0)="L"
SET DIC="^BQI(90508,"_DA(1)_",10,"
SET X="BGP SMOKER CPTS"
SET DLAYGO=90508.03
+25 KILL DD,DO
+26 DO FILE^DICN
+27 SET DA=+Y
IF DA=-1
SET DA=46
+28 SET IENS=$$IENS^DILF(.DA)
+29 SET BQIUPD(90508.03,IENS,.01)="BGP SMOKER CPTS"
+30 SET TIEN=$ORDER(^ATXAX("B","BGP SMOKER CPTS",""))
+31 SET BQIUPD(90508.03,IENS,.06)="BQIHTX"
+32 DO FILE^DIE("","BQIUPD","ERROR")
+33 SET BQIUPD(90508.03,IENS,.02)=TIEN_";ATXAX("
+34 SET BQIUPD(90508.03,IENS,.03)=2
+35 SET BQIUPD(90508.03,IENS,.05)="C"
+36 DO FILE^DIE("I","BQIUPD","ERROR")
+37 KILL BQIUPD
+38 ;
+39 ; Fix Lab entry in 90506.3
+40 NEW VIEN,DA,IENS,DIEN
+41 SET VIEN=$ORDER(^BQI(90506.3,"B","Lab",""))
SET DA(1)=VIEN
+42 SET DIEN=$ORDER(^BQI(90506.3,VIEN,10,"B","Site/Specimen",""))
+43 SET DA=DIEN
SET IENS=$$IENS^DILF(.DA)
+44 SET BQIUPD(90506.31,IENS,.05)=7
SET BQIUPD(90506.31,IENS,.08)="@"
+45 SET BQIUPD(90506.31,IENS,.09)="@"
SET BQIUPD(90506.31,IENS,.1)="@"
+46 SET DIEN=$ORDER(^BQI(90506.3,VIEN,10,"B","Result",""))
+47 SET DA=DIEN
SET IENS=$$IENS^DILF(.DA)
+48 SET BQIUPD(90506.31,IENS,.05)=5
+49 SET DIEN=$ORDER(^BQI(90506.3,VIEN,10,"B","Units",""))
+50 SET DA=DIEN
SET IENS=$$IENS^DILF(.DA)
+51 SET BQIUPD(90506.31,IENS,.05)=21
+52 SET DIEN=$ORDER(^BQI(90506.3,VIEN,10,"B","Range",""))
+53 SET DA=DIEN
SET IENS=$$IENS^DILF(.DA)
+54 SET BQIUPD(90506.31,IENS,.05)=9
+55 SET DIEN=$ORDER(^BQI(90506.3,VIEN,10,"B","Normal/Abnormal",""))
+56 SET DA=DIEN
SET IENS=$$IENS^DILF(.DA)
+57 SET BQIUPD(90506.31,IENS,.05)=6
+58 SET DIEN=$ORDER(^BQI(90506.3,VIEN,10,"B","Ordering Physician",""))
+59 SET DA=DIEN
SET IENS=$$IENS^DILF(.DA)
+60 SET BQIUPD(90506.31,IENS,.04)="H"
+61 DO FILE^DIE("","BQIUPD","ERROR")
+62 KILL BQIUPD
+63 ;
+64 ; Fix Patient Education entry in 90506.3
+65 NEW VIEN,DA,IENS,DIEN
+66 SET VIEN=$ORDER(^BQI(90506.3,"B","Patient Education",""))
SET DA(1)=VIEN
+67 SET DIEN=$ORDER(^BQI(90506.3,VIEN,10,"B","Provider",""))
+68 SET DA=DIEN
SET IENS=$$IENS^DILF(.DA)
+69 SET BQIUPD(90506.31,IENS,2.01)="APCDTPRO"
SET BQIUPD(90506.31,IENS,2.02)="EPRV(APCDTPRO)"
+70 DO FILE^DIE("","BQIUPD","ERROR")
+71 KILL BQIUPD
+72 ;
+73 ; Update alternate help text in 90506.3
+74 NEW VIEN,DA,IENS
+75 SET VIEN=$ORDER(^BQI(90506.3,"B","PCC Visit",""))
SET DA(1)=VIEN
+76 SET DIEN=$ORDER(^BQI(90506.3,VIEN,10,"B","Date",""))
+77 SET DA=DIEN
SET IENS=$$IENS^DILF(.DA)
+78 SET BQIUPD(90506.31,IENS,3.06)="Enter date of visit. Must be between patient's DOB and today."
+79 SET DIEN=$ORDER(^BQI(90506.3,VIEN,10,"B","Outside Location",""))
+80 SET DA=DIEN
SET IENS=$$IENS^DILF(.DA)
+81 SET BQIUPD(90506.31,IENS,3.06)="Enter the name of the outside facility where the visit occurred, e.g. Smith Nursing Home."
+82 SET DIEN=$ORDER(^BQI(90506.3,VIEN,10,"B","Outside Provider Name",""))
+83 SET DA=DIEN
SET IENS=$$IENS^DILF(.DA)
+84 SET BQIUPD(90506.31,IENS,3.06)="Enter the name of the patient's provider for this visit."
+85 DO FILE^DIE("","BQIUPD","ERROR")
+86 KILL BQIUPD
+87 ;
+88 ; Update generated panel description for those sites that may
+89 ; have encountered an error in the original install due to
+90 ; deleted QMan templates
+91 DO PDSC
+92 ;
+93 ; Set up task to run to regenerate Dx Categories
+94 NEW ZTDESC,ZTRTN,ZTIO,JBNOW,JBDATE,ZTDTH,ZTSK
+95 SET ZTDESC="ICARE DX CAT PROGRAM"
SET ZTRTN="DXC^BQITASK2"
SET ZTIO=""
+96 SET JBNOW=$$NOW^XLFDT()
+97 SET JBDATE=$SELECT($EXTRACT($PIECE(JBNOW,".",2),1,2)<18:DT,1:$$FMADD^XLFDT(DT,+1))
+98 SET ZTDTH=JBDATE_".18"
+99 DO ^%ZTLOAD
+100 KILL ZTDESC,ZTRTN,ZTIO,JBNOW,JBDATE,ZTDTH,ZTSK
+101 QUIT
+102 ;
PRE ; Pre-install
+1 NEW DIK,DA
+2 SET DIK="^BQI(90506.2,"
+3 SET DA=0
FOR
SET DA=$ORDER(^BQI(90506.2,DA))
IF 'DA
QUIT
DO ^DIK
+4 QUIT
+5 ;
PDSC ; Load revised generated descriptions for all panels
+1 ;
+2 NEW OWNR,PLIEN
+3 SET OWNR=0
+4 FOR
SET OWNR=$ORDER(^BQICARE(OWNR))
IF 'OWNR
QUIT
Begin DoDot:1
+5 SET PLIEN=0
+6 FOR
SET PLIEN=$ORDER(^BQICARE(OWNR,1,PLIEN))
IF 'PLIEN
QUIT
Begin DoDot:2
+7 NEW DA,IENS
+8 SET DA(1)=OWNR
SET DA=PLIEN
SET IENS=$$IENS^DILF(.DA)
+9 KILL DESC
+10 DO PEN^BQIPLDSC(OWNR,PLIEN,.DESC)
+11 DO WP^DIE(90505.01,IENS,5,"","DESC")
+12 KILL DESC,BMXSEC
End DoDot:2
End DoDot:1
+13 QUIT
