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

BQI1POJB.m

Go to the documentation of this file. 
  1. BQI1POJB ;PRXM/HC/ALA-Ver 1.0 Post Install Task Job ; 02 Mar 2006  9:52 AM
  1.  ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
  1.  Q
  1.  ;
  1. ENT ;EP - Entry point for all tagging
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQI1POJB"
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  D FLG
  1.  D DXC
  1.  D GPR
  1.  ;
  1.  NEW DIC,DIE,DR,DA
  1.  S DIC="^BQI(90508,",DA=$O(^BQI(90508,0))
  1.  I 'DA Q
  1.  S DR=".1///^S X=""@""",DIE=DIC D ^DIE
  1.  K INSTALL,UID
  1.  Q
  1.  ;
  1. FLG ;  Entry point to tag all users with flags
  1.  ;   
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQI1POJB D UNWIND^%ZTER"
  1.  I $G(DT)="" D DT^DICRW
  1.  ;  Set the DATE/TIME FLAG STARTED field
  1.  NEW DIC,DIE,DR,DA
  1.  S DIC="^BQI(90508,",DA=$O(^BQI(90508,0))
  1.  I 'DA Q
  1.  S DR=".02///^S X="_$$NOW^XLFDT(),DIE=DIC D ^DIE
  1.  ;
  1.  ; Find all flags for patients
  1.  S INSTALL=1
  1.  D FND^BQIFLG
  1.  ;
  1.  ;  Set the DATE/TIME FLAG STOPPED field
  1.  NEW DIC,DIE,DR,DA
  1.  S DIC="^BQI(90508,",DA=$O(^BQI(90508,0))
  1.  I 'DA Q
  1.  S DR=".03///^S X="_$$NOW^XLFDT(),DIE=DIC D ^DIE
  1.  Q
  1.  ;
  1. DXC ;  Tag the diagnosis categories
  1.  ; Variables
  1.  ;   BQDEF  - Diag Cat Definition Name
  1.  ;   BQEXEC - Diag Cat special executable program
  1.  ;   BQPRG  - Diag Cat standard executable program
  1.  ;   BQREF  - Taxonomy array reference
  1.  ;   BQGLBB  - Temporary global reference
  1.  ;   BQORD  - Order that the category must be determined
  1.  ;           (Some categories depend upon a patient not being
  1.  ;            in another category)
  1.  ;   BQTN   - Diag Cat internal entry number
  1.  ;
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQI1POJB D UNWIND^%ZTER"
  1.  ;   Set the DATE/TIME DXN CATEGORY STARTED field
  1.  NEW DIC,DIE,DR,DA
  1.  S DIC="^BQI(90508,",DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S DR=".06///^S X="_$$NOW^XLFDT(),DIE=DIC D ^DIE
  1.  ;
  1.  NEW BQTN,BQDEF,BQORD
  1.  S BQORD=""
  1.  F  S BQORD=$O(^BQI(90506.2,"AC",BQORD)) Q:BQORD=""  D
  1.  . S BQTN=0
  1.  . F  S BQTN=$O(^BQI(90506.2,"AC",BQORD,BQTN)) Q:'BQTN  D
  1.  .. ; If the category is marked as inactive, ignore it
  1.  .. I $$GET1^DIQ(90506.2,BQTN_",",.03,"I") Q
  1.  .. ; If the category is a subdefinition, ignore it
  1.  .. I $$GET1^DIQ(90506.2,BQTN_",",.05,"I")=1 Q
  1.  .. S BQDEF=$$GET1^DIQ(90506.2,BQTN_",",.01,"E")
  1.  .. S BQEXEC=$$GET1^DIQ(90506.2,BQTN_",",1,"E")
  1.  .. S BQPRG=$$GET1^DIQ(90506.2,BQTN_",",.04,"E")
  1.  .. ;
  1.  .. ; Set the taxonomy array from the file definition
  1.  .. S BQREF="BQIRY" K @BQREF
  1.  .. D ARY^BQITUTL(BQDEF,BQREF)
  1.  .. S BQGLBB=$NA(^TMP("BQIPOP",UID))
  1.  .. K @BQGLBB
  1.  .. ;
  1.  .. ; Call the populate category code
  1.  .. S PRGM="POP^"_BQPRG_"(BQREF,BQGLBB)"
  1.  .. D @PRGM
  1.  .. ;
  1.  .. ; File the returned patients
  1.  .. S DFN=0
  1.  .. F  S DFN=$O(@BQGLBB@(DFN)) Q:DFN=""  D FIL(BQGLBB)
  1.  .. Q
  1.  ;
  1.  K @BQGLBB,AGE,BQEXEC,BQDEF,BQPRG,@BQREF,BQREF,BQGLBB,DFN,PRGM
  1.  K SEX,TXDXCN,TXDXCT,TXT,Y
  1.  ;
  1.  ;  Set the DATE/TIME DXN CATEGORY STOPPED field
  1.  NEW DIC,DIE,DR,DA
  1.  S DIC="^BQI(90508,",DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S DR=".07///^S X="_$$NOW^XLFDT(),DIE=DIC D ^DIE
  1.  Q
  1.  ;
  1. GPR ;  Entry point to get GPRA values for all users
  1.  ;
  1.  ;Variables
  1.  ;  BQIGREF - Temporary global reference that returns the raw GPRA data
  1.  ;  BQIDATA - Global reference for iCare Patients.
  1.  ;  
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQI1POJB D UNWIND^%ZTER"
  1.  ;
  1.  NEW BGP3YE,BGPB3YE,BGPBBD,BGPBD,BGPBED,BGPED,BGPIND,BGPP3YE,BGPPBD,BGPPED
  1.  NEW BGPQTR,BGPRPT,BGPRTYPE,BQIDATA,BQIGREF,BQIH,BQIINDG,BQIPUP,BQIROU,BQIY
  1.  NEW BQIYR,IND,MCT,MEAS,SIND,BGPPER,BQIDFN
  1.  NEW DIC,DIE,DR,DA
  1.  ;
  1.  ; Set the DATE/TIME GPRA STARTED field
  1.  S DIC="^BQI(90508,",DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S DR=".04///^S X="_$$NOW^XLFDT(),DIE=DIC D ^DIE
  1.  ;
  1.  NEW DFN
  1.  S BQIGREF=$NA(^TMP("BQIGPRA",UID))
  1.  K @BQIGREF
  1.  S BQIDATA=$NA(^BQIPAT)
  1.  ;
  1.  ;  Initialize data
  1.  D INP^BQINIGHT
  1.  ;  If the routine is not defined, quit
  1.  I $G(BQIROU)="" G EXIT
  1.  ;
  1.  ;  If the tag is not defined, quit
  1.  I $T(@("BQI^"_BQIROU))="" G EXIT
  1.  ;
  1.  ;  Initialize GPRA variables
  1.  S X=0 F  S X=$O(@BQIINDG@("GPRA",1,X)) Q:X'=+X  S BGPIND(X)=""
  1.  ;
  1.  ; Define the time frame for the patient
  1.  S BGPBD=$$DATE^BQIUL1("T-12M"),BGPED=DT
  1.  S BGPBBD="300"_$E(BGPBD,4,7),BGPBED="300"_$E(BGPED,4,7)
  1.  S BGPPBD=$$DATE^BQIUL1("T-24M"),BGPPED=$$DATE^BQIUL1("T-12M")
  1.  S BGPPER=$E($$DT^XLFDT(),1,3)_"0000"
  1.  S BGPQTR=$S(BGPBD>($E(BGPBD,1,3)_"0101")&(BGPBD<($E(BGPBD,1,3)_"0331")):1,BGPBD>($E(BGPBD,1,3)_"0401")&(BGPBD<($E(BGPBD,1,3)_"0630")):2,BGPBD>($E(BGPBD,1,3)_"0701")&(BGPBD<($E(BGPBD,1,3)_"0930")):3,1:4)
  1.  S BGPRTYPE=4,BGPRPT=4
  1.  S BGP3YE=$$FMADD^XLFDT(BGPED,-1096)
  1.  S BGPP3YE=$$FMADD^XLFDT(BGPPED,-1096)
  1.  S BGPB3YE=$$FMADD^XLFDT(BGPBED,-1096)
  1.  ;
  1.  ;  For every patient in the database, call the GPRA API
  1.  S BQIDFN=0
  1.  F  S BQIDFN=$O(^AUPNPAT(BQIDFN)) Q:'BQIDFN  D
  1.  . ; If patient is deceased, don't calculate
  1.  . I $P($G(^DPT(BQIDFN,.35)),U,1)'="" Q
  1.  . ; If patient has no active HRNs, quit
  1.  . I '$$HRN^BQIUL1(BQIDFN) Q
  1.  . ; If patient has no visits in 3 years, quit
  1.  . I '$$VTHR^BQIUL1(BQIDFN) Q
  1.  . ;
  1.  . D @("BQI^"_BQIROU_"(BQIDFN,.BQIGREF)")
  1.  . ;
  1.  . ;  if the patient doesn't already exist in the iCare Patient file, add them
  1.  . I $G(^BQIPAT(BQIDFN,0))="" D
  1.  .. NEW DIC,X,DINUM,DLAYGO
  1.  .. S (X,DINUM)=BQIDFN,DLAYGO=90507.5,DIC="^BQIPAT(",DIC(0)="L"
  1.  .. K DO,DD D FILE^DICN
  1.  . ; Remove any previous GPRA data
  1.  . K @BQIDATA@(BQIDFN,30)
  1.  . S @BQIDATA@(BQIDFN,30,0)="^90507.53^^"
  1.  . ;
  1.  . ; if the patient doesn't meet any GPRA logic, quit
  1.  . I '$D(@BQIGREF@(BQIDFN)) Q
  1.  . ;
  1.  . ;  set the year of the GPRA and the begin/end dates
  1.  . S BQIPUP(90507.5,BQIDFN_",",.02)=BQIYR
  1.  . S BQIPUP(90507.5,BQIDFN_",",.03)=BGPBD
  1.  . S BQIPUP(90507.5,BQIDFN_",",.04)=BGPED
  1.  . S BQIPUP(90507.5,BQIDFN_",",.05)=$$NOW^XLFDT()
  1.  . D FILE^DIE("","BQIPUP","ERROR")
  1.  . K BQIPUP
  1.  . ;
  1.  . ;  initialize the summary indicators for the patient
  1.  . S CT=0,SIND=""
  1.  . F  S SIND=$O(^BQI(90506.1,"AC","G",SIND)) Q:SIND=""  D
  1.  .. S CT=CT+1
  1.  .. I $P(^BQI(90506.1,SIND,0),U,10)=1 Q
  1.  .. S @BQIDATA@(BQIDFN,30,CT,0)=$P(^BQI(90506.1,SIND,0),U,1)
  1.  .. S @BQIDATA@(BQIDFN,30,"B",$P(^BQI(90506.1,SIND,0),U,1),CT)=""
  1.  . ;
  1.  . S IND=0
  1.  . F  S IND=$O(@BQIGREF@(BQIDFN,IND)) Q:IND=""  D
  1.  .. S MEAS=0
  1.  .. F  S MEAS=$O(@BQIGREF@(BQIDFN,IND,MEAS)) Q:MEAS=""  D
  1.  ... S GPMEAS=BQIYR_"_"_MEAS
  1.  ... S MCT=$O(^BQIPAT(BQIDFN,30,"B",GPMEAS,"")) I MCT="" Q
  1.  ... S $P(@BQIDATA@(BQIDFN,30,MCT,0),U,2)=$P(@BQIGREF@(BQIDFN,IND),U,2)
  1.  ... S $P(@BQIDATA@(BQIDFN,30,MCT,0),U,3)=$P(@BQIGREF@(BQIDFN,IND,MEAS),U,2)
  1.  ... S $P(@BQIDATA@(BQIDFN,30,MCT,0),U,4)=$P(@BQIGREF@(BQIDFN,IND,MEAS),U,3)
  1.  . K @BQIGREF
  1.  . ; reindex the patient record
  1.  . NEW DA,DIK
  1.  . S DA=BQIDFN,DIK="^BQIPAT(" D IX1^DIK
  1.  ;
  1. EXIT ; Set the DATE/TIME GPRA STOPPED
  1.  NEW DIC,DIE,DR,DA
  1.  S DIC="^BQI(90508,",DA=$O(^BQI(90508,0)) I 'DA Q
  1.  S DR=".05///^S X="_$$NOW^XLFDT(),DIE=DIC D ^DIE
  1.  Q
  1.  ;
  1. FIL(BQGLBB) ;EP - File diagnosis category
  1.  NEW DA,IENS,DIC,X,DLAYGO,DINUM,EVN,TXN,TYP
  1.  ; Exclude deceased patients
  1.  I $P($G(^DPT(DFN,.35)),U,1)'="" Q
  1.  ;  if the patient doesn't already exist in the iCare Patient file, add them
  1.  I $G(^BQIPAT(DFN,0))="" D
  1.  . NEW DIC,X,DINUM,DLAYGO
  1.  . S (X,DINUM)=DFN,DLAYGO=90507.5,DIC="^BQIPAT(",DIC(0)="L"
  1.  . K DO,DD D FILE^DICN
  1.  ;
  1.  S DA(1)=DFN
  1.  I '$D(^BQIPAT(DFN,20,0)) S ^BQIPAT(DFN,20,0)="^90507.52P^^"
  1.  S (X,DINUM)=BQTN,DIC(0)="L",DIC="^BQIPAT("_DA(1)_",20,",DLAYGO=90507.52
  1.  K DO,DD D FILE^DICN
  1.  S DA=+Y,IENS=$$IENS^DILF(.DA)
  1.  S BQIUPD(90507.52,IENS,.02)=$$NOW^XLFDT()
  1.  S BQIUPD(90507.5,DFN_",",.06)=$$NOW^XLFDT()
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  K BQIUPD
  1.  ;
  1.  ;  Remove previous criteria
  1.  NEW DA,DIK
  1.  S DA(2)=DFN,DA(1)=BQTN,DA=0,DIK="^BQIPAT("_DA(2)_",20,"_DA(1)_",1,"
  1.  F  S DA=$O(^BQIPAT(DFN,20,BQTN,1,DA)) Q:'DA  D ^DIK
  1.  K ^BQIPAT(DFN,20,BQTN,1,"B")
  1.  ;
  1.  ;  Add the criteria on why patient met diagnosis category
  1.  S TXT=""
  1.  F  S TXT=$O(@BQGLBB@(DFN,"CRITERIA",TXT)) Q:TXT=""  D
  1.  . I '$D(^BQIPAT(DFN,20,BQTN,1,0)) S ^BQIPAT(DFN,20,BQTN,1,0)="^90507.521^^"
  1.  . NEW DA
  1.  . S DA(2)=DFN,DA(1)=BQTN,X=TXT,DIC(0)="L"
  1.  . S DIC="^BQIPAT("_DA(2)_",20,"_DA(1)_",1,",DLAYGO=90507.521
  1.  . K DO,DD D FILE^DICN
  1.  . S TXN=+Y
  1.  . I '$D(^BQIPAT(DFN,20,BQTN,1,TXN,1,0)) S ^BQIPAT(DFN,20,BQTN,1,TXN,1,0)="^90507.5211^^"
  1.  . F TYP="P" S EVN="" D
  1.  .. F  S EVN=$O(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN)) Q:EVN=""  D
  1.  ... NEW DA,IENS
  1.  ... S DA(3)=DFN,DA(2)=BQTN,DA(1)=TXN,DIC(0)="L",DLAYGO=90507.5211,X=TYP_EVN
  1.  ... S DIC="^BQIPAT("_DA(3)_",20,"_DA(2)_",1,"_DA(1)_",1,"
  1.  ... D ^DIC
  1.  ... S DA=+Y,IENS=$$IENS^DILF(.DA)
  1.  ... S BQIUPD(90507.5211,IENS,.02)=$P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN),U,1)
  1.  ... I $P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN),U,2)'="" S BQIUPD(90507.5211,IENS,.03)=$P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN),U,2)
  1.  ... I $P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN),U,3)'="" S BQIUPD(90507.5211,IENS,.04)=$P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN),U,3)
  1.  ... I $P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN),U,4)'="" S BQIUPD(90507.5211,IENS,.05)=$P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN),U,4)
  1.  ... D FILE^DIE("","BQIUPD","ERROR")
  1.  ... K BQIUPD
  1.  . F TYP="V" S EVN="" D
  1.  .. F  S EVN=$O(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN)) Q:EVN=""  D
  1.  ... S MEVN=""
  1.  ... F  S MEVN=$O(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN,MEVN)) Q:MEVN=""  D
  1.  .... NEW DA,IENS
  1.  .... S DA(3)=DFN,DA(2)=BQTN,DA(1)=TXN,DIC(0)="L",DLAYGO=90507.5211,X=TYP_EVN
  1.  .... S DIC="^BQIPAT("_DA(3)_",20,"_DA(2)_",1,"_DA(1)_",1,"
  1.  .... D ^DIC
  1.  .... I $P(Y,U,3)'=1 D
  1.  ..... I Y=-1 K DO,DD D FILE^DICN Q
  1.  ..... I $P(^BQIPAT(DFN,20,BQTN,1,TXN,1,+Y,0),U,4)'=MEVN K DO,DD D FILE^DICN
  1.  .... S DA=+Y,IENS=$$IENS^DILF(.DA)
  1.  .... S BQIUPD(90507.5211,IENS,.02)=$P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN,MEVN),U,1)
  1.  .... I $P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN,MEVN),U,2)'="" S BQIUPD(90507.5211,IENS,.03)=$P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN,MEVN),U,2)
  1.  .... I $P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN,MEVN),U,3)'="" S BQIUPD(90507.5211,IENS,.04)=$P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN,MEVN),U,3)
  1.  .... I $P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN,MEVN),U,4)'="" S BQIUPD(90507.5211,IENS,.05)=$P(@BQGLBB@(DFN,"CRITERIA",TXT,TYP,EVN,MEVN),U,4)
  1.  .... D FILE^DIE("","BQIUPD","ERROR")
  1.  .... K BQIUPD
  1.  Q
  1.  ;
  1. ERR ;  Error trapping
  1.  S BQIUPD(90508,"1,",.1)="@"
  1.  S BQIUPD(90508,"1,",.14)="@"
  1.  D FILE^DIE("","BQIUPD","ERROR")
  1.  D ^%ZTER
  1.  Q