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

BQI22POS.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. EN ;EP - Entry point
  1. ;
  1. ; Save off definitions (just in case need to restore)
  1. NEW NODE,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. .. F NODE=0,3,5,10,15 M ^ZBQICARE(OWNR,1,PLIEN,NODE)=^BQICARE(OWNR,1,PLIEN,NODE)
  1. ;
  1. GLS ; Update glossary
  1. NEW GN,GNM,GSN,BQIUPD
  1. S GN=0
  1. F S GN=$O(^BQI(90509.9,GN)) Q:'GN D
  1. . S GNM=$P(^BQI(90509.9,GN,0),U,1)
  1. . S GSN=$O(^BQI(90508.2,"B",GNM,"")) Q:GSN=""
  1. . S BQIUPD(90508.2,GSN_",",1)="@"
  1. . D FILE^DIE("","BQIUPD","ERROR")
  1. . M ^BQI(90508.2,GSN,1)=^BQI(90509.9,GN,1)
  1. ;
  1. ;Set the version number
  1. NEW DA,BJ
  1. S DA=$O(^BQI(90508,0))
  1. S BQIUPD(90508,DA_",",.08)="2.2.0.16"
  1. S BQIUPD(90508,DA_",",.09)="2.2.0T16"
  1. F BJ=.15,.16,.17,.18 S BQIUPD(90508,DA_",",BJ)="@"
  1. D FILE^DIE("","BQIUPD","ERROR")
  1. K BQIUPD
  1. ;
  1. ;Set up User Classes
  1. NEW DIC,DLAYGO,DA,X,Y
  1. S DA=$O(^BQI(90508,0))
  1. I $G(^BQI(90508,DA,13,0))="" S ^BQI(90508,DA,13,0)="^90508.013P^^"
  1. S DA(1)=DA,DIC(0)="LNZ",DLAYGO=90508.013,DIC="^BQI(90508,"_DA(1)_",13,",DIC("P")=DLAYGO
  1. F X="PHYSICIAN","PHYSICIAN ASSISTANT","NURSE PRACTITIONER" D
  1. . D ^DIC
  1. . I Y=-1 K DO,DD D FILE^DICN
  1. ;
  1. ; Set up providers
  1. D EN^DDIOL("Finding MU Providers","","!!?15")
  1. NEW BQIMPROV,PRV,DATE,PROV,DATE,VISIT,PIEN,NUM,CNT
  1. S DATE=3110101-.0001
  1. F S DATE=$O(^AUPNVSIT("B",DATE)) Q:DATE=""!(DATE\1>DT) D D EN^DDIOL(".","","?0")
  1. . S VISIT=""
  1. . F S VISIT=$O(^AUPNVSIT("B",DATE,VISIT)) Q:VISIT="" D
  1. .. S PIEN=""
  1. .. F S PIEN=$O(^AUPNVPRV("AD",VISIT,PIEN)) Q:PIEN="" D
  1. ... S PROV=$P($G(^AUPNVPRV(PIEN,0)),"^",1) I PROV="" Q
  1. ... S BQIMPROV(PROV)=$G(BQIMPROV(PROV))+1
  1. S PRV="" F S PRV=$O(BQIMPROV(PRV)) Q:PRV="" I '$D(^XUSEC("ORES",PRV)) K BQIMPROV(PRV)
  1. ;
  1. S PRV="" F S PRV=$O(BQIMPROV(PRV)) Q:PRV="" S NUM=BQIMPROV(PRV),PROV(NUM,PRV)=""
  1. S NUM="",CNT=0
  1. F S NUM=$O(PROV(NUM),-1) Q:NUM=""!(CNT=50) D
  1. . S PRV=""
  1. . F S PRV=$O(PROV(NUM,PRV)) Q:PRV=""!(CNT=50) D
  1. .. NEW DA,DIC,X,Y,DLAYGO
  1. .. S DA=$O(^BQI(90508,0))
  1. .. I $G(^BQI(90508,DA,14,0))="" S ^BQI(90508,DA,14,0)="^90508.014P^^"
  1. .. S DA(1)=DA,DIC(0)="LNZ",DLAYGO=90508.013,DIC="^BQI(90508,"_DA(1)_",14,",DIC("P")=DLAYGO
  1. .. S X=$P($G(^VA(200,PRV,0)),U,1) I X="" Q
  1. .. D ^DIC
  1. .. I Y=-1 K DO,DD D FILE^DICN
  1. .. S CNT=CNT+1
  1. ;
  1. ; Set BTPWRPC into BQIRPC
  1. NEW IEN,DA,X,DIC,Y
  1. S DA(1)=$$FIND1^DIC(19,"","B","BQIRPC","","","ERROR"),DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="LMNZ"
  1. I $G(^DIC(19,DA(1),10,0))="" S ^DIC(19,DA(1),10,0)="^19.01IP^^"
  1. S X="BTPWRPC"
  1. D ^DIC I +Y<1 K DO,DD D FILE^DICN
  1. ;
  1. ; Convert Panel Definitions
  1. NEW NDZ,PN,PR,PAR,VAL,PDA
  1. I $D(^BQICARE(.5)) K ^BQICARE(.5)
  1. S NDZ=0
  1. F S NDZ=$O(^BQICARE(NDZ)) Q:'NDZ D
  1. . S PN=0
  1. . F S PN=$O(^BQICARE(NDZ,1,PN)) Q:'PN D
  1. .. S PR=0
  1. .. F S PR=$O(^BQICARE(NDZ,1,PN,15,PR)) Q:'PR D
  1. ... S PAR=$P(^BQICARE(NDZ,1,PN,15,PR,0),U,1),VAL=$P(^(0),U,2)
  1. ... I PAR'="DEC" Q
  1. ... ; If value was 'Living', set deceased to No, add LIV as yes and INAC as no
  1. ... I VAL="L" D
  1. .... S $P(^BQICARE(NDZ,1,PN,15,PR,0),U,2)="N"
  1. .... S PDA=$$ANF^BQIPLFL1(NDZ,PN,"LIV")
  1. .... I PDA'=-1 S $P(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="Y"
  1. .... S PDA=$$ANF^BQIPLFL1(NDZ,PN,"INAC")
  1. .... I PDA'=-1 S $P(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="N"
  1. ... ; If value was 'Both', set deceased to Yes, add LIV as yes and INAC as no
  1. ... I VAL="B" D
  1. .... S $P(^BQICARE(NDZ,1,PN,15,PR,0),U,2)="Y"
  1. .... S PDA=$$ANF^BQIPLFL1(NDZ,PN,"LIV")
  1. .... I PDA'=-1 S $P(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="Y"
  1. .... S PDA=$$ANF^BQIPLFL1(NDZ,PN,"INAC")
  1. .... I PDA'=-1 S $P(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="N"
  1. ... ; If value was Deceased, add LIV as no and INAC as no
  1. ... I VAL="D" D
  1. .... S $P(^BQICARE(NDZ,1,PN,15,PR,0),U,2)="Y"
  1. .... S PDA=$$ANF^BQIPLFL1(NDZ,PN,"LIV")
  1. .... I PDA'=-1 S $P(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="N"
  1. .... S PDA=$$ANF^BQIPLFL1(NDZ,PN,"INAC")
  1. .... I PDA'=-1 S $P(^BQICARE(NDZ,1,PN,15,PDA,0),U,2)="N"
  1. .. NEW OWNR,PLIEN
  1. .. S OWNR=NDZ,PLIEN=PN
  1. .. D DSC^BQIPLFL
  1. ;
  1. ; Convert any visit detail data
  1. D ^BQI22PSC
  1. ;Convert 90505 DEFAULT VIEW (.02) field to pointer to 90506.7 file
  1. N BUSER
  1. S BUSER=0 F S BUSER=$O(^BQICARE(BUSER)) Q:'BUSER D
  1. . N DA,BQIUPD,DFVW,NDFVW,ERROR
  1. . ;
  1. . ;Pull existing entry. Cannot use $$GET1^DIQ as current value may not be
  1. . ;a pointer to 90506.7 yet.
  1. . S DFVW=$P($G(^BQICARE(BUSER,0)),U,2) I DFVW?1N.N Q
  1. . S:DFVW="" DFVW="L"
  1. . S NDFVW=$O(^BQI(90506.7,"B",DFVW,"")) Q:NDFVW=""
  1. . S DA=BUSER,BQIUPD(90505,DA_",",.02)=NDFVW
  1. . D FILE^DIE("","BQIUPD","ERROR")
  1. . K BQIUPD,ERROR
  1. K BUSER
  1. ;
  1. GPR ;Set up to compile GPRA for main view
  1. NEW DATA,II
  1. S II=0,DATA=$NA(^XTMP("BQIGPTOT")) K @DATA
  1. S @DATA@(II)=$$FMADD^XLFDT(DT,2)_U_$$DT^XLFDT()_U_"CRS Aggregate",II=II+1
  1. S @DATA@(II)="T00025REPORT_PERIOD^I00010TOTAL_PATIENTS^T00030CATEGORY^T00030CLIN_GROUP^I00010MEAS_IEN^"
  1. S @DATA@(II)=@DATA@(II)_"T00010NATIONAL_CURRENT^T00010YEAR_CURRENT^T00040INDICATOR^I00010NUMERATOR^"
  1. S @DATA@(II)=@DATA@(II)_"I00010DENOMINATOR^N00010PERCENT^T00001EXCEPTION^T00030HP_GOAL_2020"_$C(30)
  1. NEW X,Y,%DT
  1. S %DT="AEFR",%DT("A")="Enter Time to start Site CRS Aggregation Job: "
  1. ;S %DT("B")=$$FMTE^XLFDT(DT_".20")
  1. S %DT("B")="NOW"
  1. D ^%DT
  1. I X="NOW" S ZTDTH=$$FMADD^XLFDT(Y,,,3)
  1. E S ZTDTH=Y
  1. S ZTDESC="CRS Aggregation",ZTRTN="COMP^BQIGPRA5",ZTIO=""
  1. D ^%ZTLOAD
  1. K ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
  1. ;
  1. D ^BQISCHED
  1. ;
  1. ; Add new patient entries to 90506.1
  1. NEW BI,BJ,BK,BN,BQIUPD,ERROR,IEN,ND,NDATA,TEXT,VAL
  1. F BI=1:1 S TEXT=$P($T(DEM+BI),";;",2) Q:TEXT="" D
  1. . F BJ=1:1:$L(TEXT,"~") D
  1. .. S NDATA=$P(TEXT,"~",BJ)
  1. .. S ND=$P(NDATA,"|",1),VAL=$P(NDATA,"|",2)
  1. .. I ND=0 D
  1. ... NEW DIC,X,Y
  1. ... S DIC(0)="LQZ",DIC="^BQI(90506.1,",X=$P(VAL,U,1)
  1. ... D ^DIC
  1. ... S IEN=+Y
  1. ... I IEN=-1 K DO,DD D FILE^DICN S IEN=+Y
  1. .. I ND=1 S BQIUPD(90506.1,IEN_",",1)=VAL Q
  1. .. F BK=1:1:$L(VAL,"^") D
  1. ... S BN=$O(^DD(90506.1,"GL",ND,BK,"")) I BN="" Q
  1. ... I $P(VAL,"^",BK)'="" S BQIUPD(90506.1,IEN_",",BN)=$P(VAL,"^",BK) Q
  1. ... I $P(VAL,"^",BK)="" S BQIUPD(90506.1,IEN_",",BN)="@"
  1. . D FILE^DIE("","BQIUPD","ERROR")
  1. ;
  1. ; Re-Index File
  1. K ^BQI(90506.1,"AC"),^BQI(90506.1,"AD")
  1. NEW DIK
  1. S DIK="^BQI(90506.1,",DIK(1)=3.01
  1. D ENALL^DIK
  1. ;
  1. TLT ;EP - Fix tooltips
  1. NEW TEXT,BQIUPD,ERROR,BI,BJ,HELP,IEN
  1. S IEN=1
  1. F BI=1:1 S TEXT=$P($T(JTIP+BI),";;",2) Q:TEXT="" D
  1. . S HELP(BI)=TEXT
  1. D WP^DIE(90508,IEN_",",5,"","HELP","ERROR")
  1. K HELP
  1. F BI=1:1 S TEXT=$P($T(TTIP+BI),";;",2) Q:TEXT="" D
  1. . S HELP(BI)=TEXT
  1. D WP^DIE(90508,IEN_",",6,"","HELP","ERROR")
  1. K HELP
  1. Q
  1. ;
  1. JTIP ;
  1. ;;Weekly Job: Preset to run search logic once a week. Applies search logic
  1. ;;for all search types to all RPMS patient data.
  1. ;;
  1. ;;Nightly Job: Preset to run search logic each night on any new RPMS
  1. ;;visit data.
  1. ;;
  1. ;;A Blank Job: Is a job that is recommended to be run at least once a
  1. ;;month or quarterly.
  1. ;;
  1. ;;The Site Manager can change the frequency and time for any background
  1. ;;job.
  1. Q
  1. TTIP ;
  1. ;;DX Tags: Identifies ("tags") patients with key chronic condition
  1. ;;categories.
  1. ;;
  1. ;;Flags: Identifies any of 4 alerts related to Abnormal Labs, ER visits and
  1. ;;hospitalization for all patients.
  1. ;;
  1. ;;Natl Measures: Updates status of GPRA and other National performance
  1. ;;measures for all patients.
  1. ;;
  1. ;;Reminders: Updates PCC Health Maintenance and other key care management
  1. ;;(register) Reminder due/overdue data for all patients.
  1. ;;
  1. ;;TX Prompts: Identifies appropriate Treatment Prompts for all patients.
  1. ;;
  1. ;;Care Mgmt: At this time only Allergy data is updated for all patients.
  1. ;;
  1. ;;CMET Data Mining: Finds all CMET events and puts them in the 'Pending'
  1. ;;queue.
  1. ;;
  1. ;;MU Performance: Updates the MU Performance hospital and provider
  1. ;;measures.
  1. ;;
  1. ;;MU Clinical Quality: Updates the MU Clinical Quality provider measures
  1. ;;and later will update hospital measures.
  1. Q
  1. ;
  1. DEM ;
  1. ;;0|BQETH^^Ethnicity^^^^^T00030BQETH~1|S VAL=$P($$ETHN^BQIPTDMG(DFN,.01),$C(28),2)~3|1^^Demographics^O^38~5|
  1. ;;0|BQRACE^^Race^^^^^T00030BQRACE~1|S VAL=$P($$RCE^BQIPTDMG(DFN,.01),$C(28),2)~3|1^^Demographics^O^37~5|
  1. ;;0|HMLOC^85^Location of Home^O^^^^T01024HMLOC^O^^^O^O~1|S VAL=$$HMLOC^BQIPTDDG(DFN)~3|1^^Address^O^41~5|
  1. ;;0|INSCOV^^Active Insurance Coverage^^^^^T01024INSCOV^^^^^^^125~1|S VAL=$$LYO^BQIPTINS(DFN)~3|1^^Other Patient Data^O^40~5|
  1. ;;0|ALGY^^Allergies^^^^^T01024ALGY^^^^^^^125~1|S VAL=$$ALG^BQIPTALG(DFN)~3|1^^Other Patient Data^O^39~5|