- 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|