BQI22POS ;VNGT/HS/ALA-Version 2.2 Post-Install ; 24 Feb 2011 11:45 AM
;;2.2;ICARE MANAGEMENT SYSTEM;;Jul 28, 2011;Build 37
;
;
EN ;EP - Entry point
;
; Save off definitions (just in case need to restore)
NEW NODE,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
.. F NODE=0,3,5,10,15 M ^ZBQICARE(OWNR,1,PLIEN,NODE)=^BQICARE(OWNR,1,PLIEN,NODE)
;
GLS ; Update glossary
NEW GN,GNM,GSN,BQIUPD
S GN=0
F S GN=$O(^BQI(90509.9,GN)) Q:'GN D
. S GNM=$P(^BQI(90509.9,GN,0),U,1)
. S GSN=$O(^BQI(90508.2,"B",GNM,"")) Q:GSN=""
. S BQIUPD(90508.2,GSN_",",1)="@"
. D FILE^DIE("","BQIUPD","ERROR")
. M ^BQI(90508.2,GSN,1)=^BQI(90509.9,GN,1)
;
;Set the version number
NEW DA,BJ
S DA=$O(^BQI(90508,0))
S BQIUPD(90508,DA_",",.08)="2.2.0.16"
S BQIUPD(90508,DA_",",.09)="2.2.0T16"
F BJ=.15,.16,.17,.18 S BQIUPD(90508,DA_",",BJ)="@"
D FILE^DIE("","BQIUPD","ERROR")
K BQIUPD
;
;Set up User Classes
NEW DIC,DLAYGO,DA,X,Y
S DA=$O(^BQI(90508,0))
I $G(^BQI(90508,DA,13,0))="" S ^BQI(90508,DA,13,0)="^90508.013P^^"
S DA(1)=DA,DIC(0)="LNZ",DLAYGO=90508.013,DIC="^BQI(90508,"_DA(1)_",13,",DIC("P")=DLAYGO
F X="PHYSICIAN","PHYSICIAN ASSISTANT","NURSE PRACTITIONER" D
. D ^DIC
. I Y=-1 K DO,DD D FILE^DICN
;
; Set up providers
D EN^DDIOL("Finding MU Providers","","!!?15")
NEW BQIMPROV,PRV,DATE,PROV,DATE,VISIT,PIEN,NUM,CNT
S DATE=3110101-.0001
F S DATE=$O(^AUPNVSIT("B",DATE)) Q:DATE=""!(DATE\1>DT) D D EN^DDIOL(".","","?0")
. S VISIT=""
. F S VISIT=$O(^AUPNVSIT("B",DATE,VISIT)) Q:VISIT="" D
.. S PIEN=""
.. F S PIEN=$O(^AUPNVPRV("AD",VISIT,PIEN)) Q:PIEN="" D
... S PROV=$P($G(^AUPNVPRV(PIEN,0)),"^",1) I PROV="" Q
... S BQIMPROV(PROV)=$G(BQIMPROV(PROV))+1
S PRV="" F S PRV=$O(BQIMPROV(PRV)) Q:PRV="" I '$D(^XUSEC("ORES",PRV)) K BQIMPROV(PRV)
;
S PRV="" F S PRV=$O(BQIMPROV(PRV)) Q:PRV="" S NUM=BQIMPROV(PRV),PROV(NUM,PRV)=""
S NUM="",CNT=0
F S NUM=$O(PROV(NUM),-1) Q:NUM=""!(CNT=50) D
. S PRV=""
. F S PRV=$O(PROV(NUM,PRV)) Q:PRV=""!(CNT=50) D
.. NEW DA,DIC,X,Y,DLAYGO
.. S DA=$O(^BQI(90508,0))
.. I $G(^BQI(90508,DA,14,0))="" S ^BQI(90508,DA,14,0)="^90508.014P^^"
.. S DA(1)=DA,DIC(0)="LNZ",DLAYGO=90508.013,DIC="^BQI(90508,"_DA(1)_",14,",DIC("P")=DLAYGO
.. S X=$P($G(^VA(200,PRV,0)),U,1) I X="" Q
.. D ^DIC
.. I Y=-1 K DO,DD D FILE^DICN
.. S CNT=CNT+1
;
; Set BTPWRPC into BQIRPC
NEW IEN,DA,X,DIC,Y
S DA(1)=$$FIND1^DIC(19,"","B","BQIRPC","","","ERROR"),DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="LMNZ"
I $G(^DIC(19,DA(1),10,0))="" S ^DIC(19,DA(1),10,0)="^19.01IP^^"
S X="BTPWRPC"
D ^DIC I +Y<1 K DO,DD D FILE^DICN
;
; Convert Panel Definitions
NEW NDZ,PN,PR,PAR,VAL,PDA
I $D(^BQICARE(.5)) K ^BQICARE(.5)
S NDZ=0
F S NDZ=$O(^BQICARE(NDZ)) Q:'NDZ D
. S PN=0
. F S PN=$O(^BQICARE(NDZ,1,PN)) Q:'PN D
.. S PR=0
.. F S PR=$O(^BQICARE(NDZ,1,PN,15,PR)) Q:'PR D
... S PAR=$P(^BQICARE(NDZ,1,PN,15,PR,0),U,1),VAL=$P(^(0),U,2)
... I PAR'="DEC" Q
... ; If value was 'Living', set deceased to No, add LIV as yes and INAC as no
... I VAL="L" D
.... S $P(^BQICARE(NDZ,1,PN,15,PR,0),U,2)="N"
.... S PDA=$$ANF^BQIPLFL1(NDZ,PN,"LIV")
.... I PDA'=-1 S $P(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="Y"
.... S PDA=$$ANF^BQIPLFL1(NDZ,PN,"INAC")
.... I PDA'=-1 S $P(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="N"
... ; If value was 'Both', set deceased to Yes, add LIV as yes and INAC as no
... I VAL="B" D
.... S $P(^BQICARE(NDZ,1,PN,15,PR,0),U,2)="Y"
.... S PDA=$$ANF^BQIPLFL1(NDZ,PN,"LIV")
.... I PDA'=-1 S $P(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="Y"
.... S PDA=$$ANF^BQIPLFL1(NDZ,PN,"INAC")
.... I PDA'=-1 S $P(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="N"
... ; If value was Deceased, add LIV as no and INAC as no
... I VAL="D" D
.... S $P(^BQICARE(NDZ,1,PN,15,PR,0),U,2)="Y"
.... S PDA=$$ANF^BQIPLFL1(NDZ,PN,"LIV")
.... I PDA'=-1 S $P(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="N"
.... S PDA=$$ANF^BQIPLFL1(NDZ,PN,"INAC")
.... I PDA'=-1 S $P(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="N"
.. NEW OWNR,PLIEN
.. S OWNR=NDZ,PLIEN=PN
.. D DSC^BQIPLFL
;
; Convert any visit detail data
D ^BQI22PSC
;Convert 90505 DEFAULT VIEW (.02) field to pointer to 90506.7 file
N BUSER
S BUSER=0 F S BUSER=$O(^BQICARE(BUSER)) Q:'BUSER D
. N DA,BQIUPD,DFVW,NDFVW,ERROR
. ;
. ;Pull existing entry. Cannot use $$GET1^DIQ as current value may not be
. ;a pointer to 90506.7 yet.
. S DFVW=$P($G(^BQICARE(BUSER,0)),U,2) I DFVW?1N.N Q
. S:DFVW="" DFVW="L"
. S NDFVW=$O(^BQI(90506.7,"B",DFVW,"")) Q:NDFVW=""
. S DA=BUSER,BQIUPD(90505,DA_",",.02)=NDFVW
. D FILE^DIE("","BQIUPD","ERROR")
. K BQIUPD,ERROR
K BUSER
;
GPR ;Set up to compile GPRA for main view
NEW DATA,II
S II=0,DATA=$NA(^XTMP("BQIGPTOT")) K @DATA
S @DATA@(II)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"CRS Aggregate",II=II+1
S @DATA@(II)="T00025REPORT_PERIOD^I00010TOTAL_PATIENTS^T00030CATEGORY^T00030CLIN_GROUP^I00010MEAS_IEN^"
S @DATA@(II)=@DATA@(II)_"T00010NATIONAL_CURRENT^T00010YEAR_CURRENT^T00040INDICATOR^I00010NUMERATOR^"
S @DATA@(II)=@DATA@(II)_"I00010DENOMINATOR^N00010PERCENT^T00001EXCEPTION^T00030HP_GOAL_2020"_$C(30)
NEW X,Y,%DT
S %DT="AEFR",%DT("A")="Enter Time to start Site CRS Aggregation Job: "
;S %DT("B")=$$FMTE^XLFDT(DT_".20")
S %DT("B")="NOW"
D ^%DT
I X="NOW" S ZTDTH=$$FMADD^XLFDT(Y,,,3)
E S ZTDTH=Y
S ZTDESC="CRS Aggregation",ZTRTN="COMP^BQIGPRA5",ZTIO=""
D ^%ZTLOAD
K ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
;
D ^BQISCHED
;
; Add new patient entries to 90506.1
NEW BI,BJ,BK,BN,BQIUPD,ERROR,IEN,ND,NDATA,TEXT,VAL
F BI=1:1 S TEXT=$P($T(DEM+BI),";;",2) Q:TEXT="" D
. F BJ=1:1:$L(TEXT,"~") D
.. S NDATA=$P(TEXT,"~",BJ)
.. S ND=$P(NDATA,"|",1),VAL=$P(NDATA,"|",2)
.. I ND=0 D
... NEW DIC,X,Y
... S DIC(0)="LQZ",DIC="^BQI(90506.1,",X=$P(VAL,U,1)
... D ^DIC
... S IEN=+Y
... I IEN=-1 K DO,DD D FILE^DICN S IEN=+Y
.. I ND=1 S BQIUPD(90506.1,IEN_",",1)=VAL Q
.. F BK=1:1:$L(VAL,"^") D
... S BN=$O(^DD(90506.1,"GL",ND,BK,"")) I BN="" Q
... I $P(VAL,"^",BK)'="" S BQIUPD(90506.1,IEN_",",BN)=$P(VAL,"^",BK) Q
... I $P(VAL,"^",BK)="" S BQIUPD(90506.1,IEN_",",BN)="@"
. D FILE^DIE("","BQIUPD","ERROR")
;
; Re-Index File
K ^BQI(90506.1,"AC"),^BQI(90506.1,"AD")
NEW DIK
S DIK="^BQI(90506.1,",DIK(1)=3.01
D ENALL^DIK
;
TLT ;EP - Fix tooltips
NEW TEXT,BQIUPD,ERROR,BI,BJ,HELP,IEN
S IEN=1
F BI=1:1 S TEXT=$P($T(JTIP+BI),";;",2) Q:TEXT="" D
. S HELP(BI)=TEXT
D WP^DIE(90508,IEN_",",5,"","HELP","ERROR")
K HELP
F BI=1:1 S TEXT=$P($T(TTIP+BI),";;",2) Q:TEXT="" D
. S HELP(BI)=TEXT
D WP^DIE(90508,IEN_",",6,"","HELP","ERROR")
K HELP
Q
;
JTIP ;
;;Weekly Job: Preset to run search logic once a week. Applies search logic
;;for all search types to all RPMS patient data.
;;
;;Nightly Job: Preset to run search logic each night on any new RPMS
;;visit data.
;;
;;A Blank Job: Is a job that is recommended to be run at least once a
;;month or quarterly.
;;
;;The Site Manager can change the frequency and time for any background
;;job.
Q
TTIP ;
;;DX Tags: Identifies ("tags") patients with key chronic condition
;;categories.
;;
;;Flags: Identifies any of 4 alerts related to Abnormal Labs, ER visits and
;;hospitalization for all patients.
;;
;;Natl Measures: Updates status of GPRA and other National performance
;;measures for all patients.
;;
;;Reminders: Updates PCC Health Maintenance and other key care management
;;(register) Reminder due/overdue data for all patients.
;;
;;TX Prompts: Identifies appropriate Treatment Prompts for all patients.
;;
;;Care Mgmt: At this time only Allergy data is updated for all patients.
;;
;;CMET Data Mining: Finds all CMET events and puts them in the 'Pending'
;;queue.
;;
;;MU Performance: Updates the MU Performance hospital and provider
;;measures.
;;
;;MU Clinical Quality: Updates the MU Clinical Quality provider measures
;;and later will update hospital measures.
Q
;
DEM ;
;;0|BQETH^^Ethnicity^^^^^T00030BQETH~1|S VAL=$P($$ETHN^BQIPTDMG(DFN,.01),$C(28),2)~3|1^^Demographics^O^38~5|
;;0|BQRACE^^Race^^^^^T00030BQRACE~1|S VAL=$P($$RCE^BQIPTDMG(DFN,.01),$C(28),2)~3|1^^Demographics^O^37~5|
;;0|HMLOC^85^Location of Home^O^^^^T01024HMLOC^O^^^O^O~1|S VAL=$$HMLOC^BQIPTDDG(DFN)~3|1^^Address^O^41~5|
;;0|INSCOV^^Active Insurance Coverage^^^^^T01024INSCOV^^^^^^^125~1|S VAL=$$LYO^BQIPTINS(DFN)~3|1^^Other Patient Data^O^40~5|
;;0|ALGY^^Allergies^^^^^T01024ALGY^^^^^^^125~1|S VAL=$$ALG^BQIPTALG(DFN)~3|1^^Other Patient Data^O^39~5|
BQI22POS ;VNGT/HS/ALA-Version 2.2 Post-Install ; 24 Feb 2011 11:45 AM
+1 ;;2.2;ICARE MANAGEMENT SYSTEM;;Jul 28, 2011;Build 37
+2 ;
+3 ;
EN ;EP - Entry point
+1 ;
+2 ; Save off definitions (just in case need to restore)
+3 NEW NODE,OWNR,PLIEN
+4 SET OWNR=0
+5 FOR
SET OWNR=$ORDER(^BQICARE(OWNR))
IF 'OWNR
QUIT
Begin DoDot:1
+6 SET PLIEN=0
+7 FOR
SET PLIEN=$ORDER(^BQICARE(OWNR,1,PLIEN))
IF 'PLIEN
QUIT
Begin DoDot:2
+8 FOR NODE=0,3,5,10,15
MERGE ^ZBQICARE(OWNR,1,PLIEN,NODE)=^BQICARE(OWNR,1,PLIEN,NODE)
End DoDot:2
End DoDot:1
+9 ;
GLS ; Update glossary
+1 NEW GN,GNM,GSN,BQIUPD
+2 SET GN=0
+3 FOR
SET GN=$ORDER(^BQI(90509.9,GN))
IF 'GN
QUIT
Begin DoDot:1
+4 SET GNM=$PIECE(^BQI(90509.9,GN,0),U,1)
+5 SET GSN=$ORDER(^BQI(90508.2,"B",GNM,""))
IF GSN=""
QUIT
+6 SET BQIUPD(90508.2,GSN_",",1)="@"
+7 DO FILE^DIE("","BQIUPD","ERROR")
+8 MERGE ^BQI(90508.2,GSN,1)=^BQI(90509.9,GN,1)
End DoDot:1
+9 ;
+10 ;Set the version number
+11 NEW DA,BJ
+12 SET DA=$ORDER(^BQI(90508,0))
+13 SET BQIUPD(90508,DA_",",.08)="2.2.0.16"
+14 SET BQIUPD(90508,DA_",",.09)="2.2.0T16"
+15 FOR BJ=.15,.16,.17,.18
SET BQIUPD(90508,DA_",",BJ)="@"
+16 DO FILE^DIE("","BQIUPD","ERROR")
+17 KILL BQIUPD
+18 ;
+19 ;Set up User Classes
+20 NEW DIC,DLAYGO,DA,X,Y
+21 SET DA=$ORDER(^BQI(90508,0))
+22 IF $GET(^BQI(90508,DA,13,0))=""
SET ^BQI(90508,DA,13,0)="^90508.013P^^"
+23 SET DA(1)=DA
SET DIC(0)="LNZ"
SET DLAYGO=90508.013
SET DIC="^BQI(90508,"_DA(1)_",13,"
SET DIC("P")=DLAYGO
+24 FOR X="PHYSICIAN","PHYSICIAN ASSISTANT","NURSE PRACTITIONER"
Begin DoDot:1
+25 DO ^DIC
+26 IF Y=-1
KILL DO,DD
DO FILE^DICN
End DoDot:1
+27 ;
+28 ; Set up providers
+29 DO EN^DDIOL("Finding MU Providers","","!!?15")
+30 NEW BQIMPROV,PRV,DATE,PROV,DATE,VISIT,PIEN,NUM,CNT
+31 SET DATE=3110101-.0001
+32 FOR
SET DATE=$ORDER(^AUPNVSIT("B",DATE))
IF DATE=""!(DATE\1>DT)
QUIT
Begin DoDot:1
+33 SET VISIT=""
+34 FOR
SET VISIT=$ORDER(^AUPNVSIT("B",DATE,VISIT))
IF VISIT=""
QUIT
Begin DoDot:2
+35 SET PIEN=""
+36 FOR
SET PIEN=$ORDER(^AUPNVPRV("AD",VISIT,PIEN))
IF PIEN=""
QUIT
Begin DoDot:3
+37 SET PROV=$PIECE($GET(^AUPNVPRV(PIEN,0)),"^",1)
IF PROV=""
QUIT
+38 SET BQIMPROV(PROV)=$GET(BQIMPROV(PROV))+1
End DoDot:3
End DoDot:2
End DoDot:1
DO EN^DDIOL(".","","?0")
+39 SET PRV=""
FOR
SET PRV=$ORDER(BQIMPROV(PRV))
IF PRV=""
QUIT
IF '$DATA(^XUSEC("ORES",PRV))
KILL BQIMPROV(PRV)
+40 ;
+41 SET PRV=""
FOR
SET PRV=$ORDER(BQIMPROV(PRV))
IF PRV=""
QUIT
SET NUM=BQIMPROV(PRV)
SET PROV(NUM,PRV)=""
+42 SET NUM=""
SET CNT=0
+43 FOR
SET NUM=$ORDER(PROV(NUM),-1)
IF NUM=""!(CNT=50)
QUIT
Begin DoDot:1
+44 SET PRV=""
+45 FOR
SET PRV=$ORDER(PROV(NUM,PRV))
IF PRV=""!(CNT=50)
QUIT
Begin DoDot:2
+46 NEW DA,DIC,X,Y,DLAYGO
+47 SET DA=$ORDER(^BQI(90508,0))
+48 IF $GET(^BQI(90508,DA,14,0))=""
SET ^BQI(90508,DA,14,0)="^90508.014P^^"
+49 SET DA(1)=DA
SET DIC(0)="LNZ"
SET DLAYGO=90508.013
SET DIC="^BQI(90508,"_DA(1)_",14,"
SET DIC("P")=DLAYGO
+50 SET X=$PIECE($GET(^VA(200,PRV,0)),U,1)
IF X=""
QUIT
+51 DO ^DIC
+52 IF Y=-1
KILL DO,DD
DO FILE^DICN
+53 SET CNT=CNT+1
End DoDot:2
End DoDot:1
+54 ;
+55 ; Set BTPWRPC into BQIRPC
+56 NEW IEN,DA,X,DIC,Y
+57 SET DA(1)=$$FIND1^DIC(19,"","B","BQIRPC","","","ERROR")
SET DIC="^DIC(19,"_DA(1)_",10,"
SET DIC(0)="LMNZ"
+58 IF $GET(^DIC(19,DA(1),10,0))=""
SET ^DIC(19,DA(1),10,0)="^19.01IP^^"
+59 SET X="BTPWRPC"
+60 DO ^DIC
IF +Y<1
KILL DO,DD
DO FILE^DICN
+61 ;
+62 ; Convert Panel Definitions
+63 NEW NDZ,PN,PR,PAR,VAL,PDA
+64 IF $DATA(^BQICARE(.5))
KILL ^BQICARE(.5)
+65 SET NDZ=0
+66 FOR
SET NDZ=$ORDER(^BQICARE(NDZ))
IF 'NDZ
QUIT
Begin DoDot:1
+67 SET PN=0
+68 FOR
SET PN=$ORDER(^BQICARE(NDZ,1,PN))
IF 'PN
QUIT
Begin DoDot:2
+69 SET PR=0
+70 FOR
SET PR=$ORDER(^BQICARE(NDZ,1,PN,15,PR))
IF 'PR
QUIT
Begin DoDot:3
+71 SET PAR=$PIECE(^BQICARE(NDZ,1,PN,15,PR,0),U,1)
SET VAL=$PIECE(^(0),U,2)
+72 IF PAR'="DEC"
QUIT
+73 ; If value was 'Living', set deceased to No, add LIV as yes and INAC as no
+74 IF VAL="L"
Begin DoDot:4
+75 SET $PIECE(^BQICARE(NDZ,1,PN,15,PR,0),U,2)="N"
+76 SET PDA=$$ANF^BQIPLFL1(NDZ,PN,"LIV")
+77 IF PDA'=-1
SET $PIECE(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="Y"
+78 SET PDA=$$ANF^BQIPLFL1(NDZ,PN,"INAC")
+79 IF PDA'=-1
SET $PIECE(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="N"
End DoDot:4
+80 ; If value was 'Both', set deceased to Yes, add LIV as yes and INAC as no
+81 IF VAL="B"
Begin DoDot:4
+82 SET $PIECE(^BQICARE(NDZ,1,PN,15,PR,0),U,2)="Y"
+83 SET PDA=$$ANF^BQIPLFL1(NDZ,PN,"LIV")
+84 IF PDA'=-1
SET $PIECE(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="Y"
+85 SET PDA=$$ANF^BQIPLFL1(NDZ,PN,"INAC")
+86 IF PDA'=-1
SET $PIECE(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="N"
End DoDot:4
+87 ; If value was Deceased, add LIV as no and INAC as no
+88 IF VAL="D"
Begin DoDot:4
+89 SET $PIECE(^BQICARE(NDZ,1,PN,15,PR,0),U,2)="Y"
+90 SET PDA=$$ANF^BQIPLFL1(NDZ,PN,"LIV")
+91 IF PDA'=-1
SET $PIECE(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="N"
+92 SET PDA=$$ANF^BQIPLFL1(NDZ,PN,"INAC")
+93 IF PDA'=-1
SET $PIECE(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="N"
End DoDot:4
End DoDot:3
+94 NEW OWNR,PLIEN
+95 SET OWNR=NDZ
SET PLIEN=PN
+96 DO DSC^BQIPLFL
End DoDot:2
End DoDot:1
+97 ;
+98 ; Convert any visit detail data
+99 DO ^BQI22PSC
+100 ;Convert 90505 DEFAULT VIEW (.02) field to pointer to 90506.7 file
+101 NEW BUSER
+102 SET BUSER=0
FOR
SET BUSER=$ORDER(^BQICARE(BUSER))
IF 'BUSER
QUIT
Begin DoDot:1
+103 NEW DA,BQIUPD,DFVW,NDFVW,ERROR
+104 ;
+105 ;Pull existing entry. Cannot use $$GET1^DIQ as current value may not be
+106 ;a pointer to 90506.7 yet.
+107 SET DFVW=$PIECE($GET(^BQICARE(BUSER,0)),U,2)
IF DFVW?1N.N
QUIT
+108 IF DFVW=""
SET DFVW="L"
+109 SET NDFVW=$ORDER(^BQI(90506.7,"B",DFVW,""))
IF NDFVW=""
QUIT
+110 SET DA=BUSER
SET BQIUPD(90505,DA_",",.02)=NDFVW
+111 DO FILE^DIE("","BQIUPD","ERROR")
+112 KILL BQIUPD,ERROR
End DoDot:1
+113 KILL BUSER
+114 ;
GPR ;Set up to compile GPRA for main view
+1 NEW DATA,II
+2 SET II=0
SET DATA=$NAME(^XTMP("BQIGPTOT"))
KILL @DATA
+3 SET @DATA@(II)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"CRS Aggregate"
SET II=II+1
+4 SET @DATA@(II)="T00025REPORT_PERIOD^I00010TOTAL_PATIENTS^T00030CATEGORY^T00030CLIN_GROUP^I00010MEAS_IEN^"
+5 SET @DATA@(II)=@DATA@(II)_"T00010NATIONAL_CURRENT^T00010YEAR_CURRENT^T00040INDICATOR^I00010NUMERATOR^"
+6 SET @DATA@(II)=@DATA@(II)_"I00010DENOMINATOR^N00010PERCENT^T00001EXCEPTION^T00030HP_GOAL_2020"_$CHAR(30)
+7 NEW X,Y,%DT
+8 SET %DT="AEFR"
SET %DT("A")="Enter Time to start Site CRS Aggregation Job: "
+9 ;S %DT("B")=$$FMTE^XLFDT(DT_".20")
+10 SET %DT("B")="NOW"
+11 DO ^%DT
+12 IF X="NOW"
SET ZTDTH=$$FMADD^XLFDT(Y,,,3)
+13 IF '$TEST
SET ZTDTH=Y
+14 SET ZTDESC="CRS Aggregation"
SET ZTRTN="COMP^BQIGPRA5"
SET ZTIO=""
+15 DO ^%ZTLOAD
+16 KILL ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
+17 ;
+18 DO ^BQISCHED
+19 ;
+20 ; Add new patient entries to 90506.1
+21 NEW BI,BJ,BK,BN,BQIUPD,ERROR,IEN,ND,NDATA,TEXT,VAL
+22 FOR BI=1:1
SET TEXT=$PIECE($TEXT(DEM+BI),";;",2)
IF TEXT=""
QUIT
Begin DoDot:1
+23 FOR BJ=1:1:$LENGTH(TEXT,"~")
Begin DoDot:2
+24 SET NDATA=$PIECE(TEXT,"~",BJ)
+25 SET ND=$PIECE(NDATA,"|",1)
SET VAL=$PIECE(NDATA,"|",2)
+26 IF ND=0
Begin DoDot:3
+27 NEW DIC,X,Y
+28 SET DIC(0)="LQZ"
SET DIC="^BQI(90506.1,"
SET X=$PIECE(VAL,U,1)
+29 DO ^DIC
+30 SET IEN=+Y
+31 IF IEN=-1
KILL DO,DD
DO FILE^DICN
SET IEN=+Y
End DoDot:3
+32 IF ND=1
SET BQIUPD(90506.1,IEN_",",1)=VAL
QUIT
+33 FOR BK=1:1:$LENGTH(VAL,"^")
Begin DoDot:3
+34 SET BN=$ORDER(^DD(90506.1,"GL",ND,BK,""))
IF BN=""
QUIT
+35 IF $PIECE(VAL,"^",BK)'=""
SET BQIUPD(90506.1,IEN_",",BN)=$PIECE(VAL,"^",BK)
QUIT
+36 IF $PIECE(VAL,"^",BK)=""
SET BQIUPD(90506.1,IEN_",",BN)="@"
End DoDot:3
End DoDot:2
+37 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:1
+38 ;
+39 ; Re-Index File
+40 KILL ^BQI(90506.1,"AC"),^BQI(90506.1,"AD")
+41 NEW DIK
+42 SET DIK="^BQI(90506.1,"
SET DIK(1)=3.01
+43 DO ENALL^DIK
+44 ;
TLT ;EP - Fix tooltips
+1 NEW TEXT,BQIUPD,ERROR,BI,BJ,HELP,IEN
+2 SET IEN=1
+3 FOR BI=1:1
SET TEXT=$PIECE($TEXT(JTIP+BI),";;",2)
IF TEXT=""
QUIT
Begin DoDot:1
+4 SET HELP(BI)=TEXT
End DoDot:1
+5 DO WP^DIE(90508,IEN_",",5,"","HELP","ERROR")
+6 KILL HELP
+7 FOR BI=1:1
SET TEXT=$PIECE($TEXT(TTIP+BI),";;",2)
IF TEXT=""
QUIT
Begin DoDot:1
+8 SET HELP(BI)=TEXT
End DoDot:1
+9 DO WP^DIE(90508,IEN_",",6,"","HELP","ERROR")
+10 KILL HELP
+11 QUIT
+12 ;
JTIP ;
+1 ;;Weekly Job: Preset to run search logic once a week. Applies search logic
+2 ;;for all search types to all RPMS patient data.
+3 ;;
+4 ;;Nightly Job: Preset to run search logic each night on any new RPMS
+5 ;;visit data.
+6 ;;
+7 ;;A Blank Job: Is a job that is recommended to be run at least once a
+8 ;;month or quarterly.
+9 ;;
+10 ;;The Site Manager can change the frequency and time for any background
+11 ;;job.
+12 QUIT
TTIP ;
+1 ;;DX Tags: Identifies ("tags") patients with key chronic condition
+2 ;;categories.
+3 ;;
+4 ;;Flags: Identifies any of 4 alerts related to Abnormal Labs, ER visits and
+5 ;;hospitalization for all patients.
+6 ;;
+7 ;;Natl Measures: Updates status of GPRA and other National performance
+8 ;;measures for all patients.
+9 ;;
+10 ;;Reminders: Updates PCC Health Maintenance and other key care management
+11 ;;(register) Reminder due/overdue data for all patients.
+12 ;;
+13 ;;TX Prompts: Identifies appropriate Treatment Prompts for all patients.
+14 ;;
+15 ;;Care Mgmt: At this time only Allergy data is updated for all patients.
+16 ;;
+17 ;;CMET Data Mining: Finds all CMET events and puts them in the 'Pending'
+18 ;;queue.
+19 ;;
+20 ;;MU Performance: Updates the MU Performance hospital and provider
+21 ;;measures.
+22 ;;
+23 ;;MU Clinical Quality: Updates the MU Clinical Quality provider measures
+24 ;;and later will update hospital measures.
+25 QUIT
+26 ;
DEM ;
+1 ;;0|BQETH^^Ethnicity^^^^^T00030BQETH~1|S VAL=$P($$ETHN^BQIPTDMG(DFN,.01),$C(28),2)~3|1^^Demographics^O^38~5|
+2 ;;0|BQRACE^^Race^^^^^T00030BQRACE~1|S VAL=$P($$RCE^BQIPTDMG(DFN,.01),$C(28),2)~3|1^^Demographics^O^37~5|
+3 ;;0|HMLOC^85^Location of Home^O^^^^T01024HMLOC^O^^^O^O~1|S VAL=$$HMLOC^BQIPTDDG(DFN)~3|1^^Address^O^41~5|
+4 ;;0|INSCOV^^Active Insurance Coverage^^^^^T01024INSCOV^^^^^^^125~1|S VAL=$$LYO^BQIPTINS(DFN)~3|1^^Other Patient Data^O^40~5|
+5 ;;0|ALGY^^Allergies^^^^^T01024ALGY^^^^^^^125~1|S VAL=$$ALG^BQIPTALG(DFN)~3|1^^Other Patient Data^O^39~5|
