BQINIGH4 ;GDIT/HS/ALA-Nightly process ; 02 Jan 2015 12:21 PM
;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27
;
;
REG ;EP - Check for register updates and apply in iCare
; Process register records into tags
NEW REGIEN,RDATA,TAG,FILE,FIELD,XREF,STFILE,STFLD,STEX,SUBREG,GLBREF,GLBNOD
NEW DFN,RIEN,QFL,DATE,TGNM,PSTAT,DATA
S REGIEN=0
F S REGIEN=$O(^BQI(90507,REGIEN)) Q:'REGIEN D
. S RDATA=^BQI(90507,REGIEN,0)
. ; If the register is inactive, quit
. I $P(RDATA,U,8)=1 Q
. ; Check if register is associated with a tag, if there isn't one, quit
. S TAG=$O(^BQI(90506.2,"AD",REGIEN,"")) I TAG="" Q
. S FILE=$P(RDATA,U,7),FIELD=$P(RDATA,U,5),XREF=$P(RDATA,U,6)
. S STFILE=$P(RDATA,U,15),STFLD=$P(RDATA,U,14),STEX=$G(^BQI(90507,REGIEN,1))
. S SUBREG=$P(RDATA,U,9)
. S GLBREF=$$ROOT^DILFD(FILE,"")_XREF_")"
. S GLBNOD=$$ROOT^DILFD(FILE,"",1)
. I GLBNOD="" Q
. ;
. I '$D(@GLBNOD@(0)) Q
. ;
. S DFN=""
. F S DFN=$O(@GLBREF@(DFN)) Q:DFN="" D
.. ; If patient is deceased, quit
.. I $P($G(^DPT(DFN,.35)),U,1)'="" Q
.. ; If patient has no active HRNs, quit
.. I '$$HRN^BQIUL1(DFN) Q
.. ; If patient has no visit in last 3 years, quit
.. I '$$VTHR^BQIUL1(DFN) Q
.. ;
.. I $G(SUBREG)'="" S QFL=0 D Q:'QFL
... Q:FILE'=9002241
... S RIEN=""
... F S RIEN=$O(@GLBREF@(DFN,RIEN)) Q:RIEN="" D
.... I $P($G(@GLBNOD@(RIEN,0)),U,5)=SUBREG S QFL=1,IENS=RIEN
.. ; Check register status
.. I $G(SUBREG)="" S IENS=$O(@GLBREF@(DFN,""))
.. I STEX'="" X STEX Q:'$D(IENS)
.. S PSTAT=$$GET1^DIQ(STFILE,IENS,STFLD,"I")
.. S DATE=$P($G(^BQIPAT(DFN,20,TAG,0)),U,2)
.. I $O(^BQIREG("C",DFN,TAG,""))'="" Q
.. I PSTAT="U"!(PSTAT="") D Q
... ; If patient is already tagged, quit
... I $O(^BQIPAT(DFN,20,TAG,0))'="" Q
... ; else build a "proposed" record
... D EN^BQITDPRC(.DATA,DFN,TAG,"P",DATE,"NIGHTLY JOB",8,"Register status is "_PSTAT) Q
.. I PSTAT="D" Q
.. I PSTAT="I" D Q
... ; If the patient was not tagged and is inactive on register, quit
... I $O(^BQIPAT(DFN,20,TAG,0))="" Q
... ; If the patient was tagged and is inactive on register
... D EN^BQITDPRC(.DATA,DFN,TAG,"P",DATE,"NIGHTLY JOB",8,"Register status is "_PSTAT) Q
.. D EN^BQITDPRC(.DATA,DFN,TAG,"A",DATE,"NIGHTLY JOB",8,"Register status is "_PSTAT)
.. ; Remove any temporary BQIPAT data
.. NEW DA,DIK
.. S DA(1)=DFN,DA=TAG,DIK="^BQIPAT("_DA(1)_",20,"
.. D ^DIK
Q
;
RTAX ;EP - Check for report taxonomies
;determine if any taxonomies need deconstruction for Source and layouts
; For HIV/AIDS Quality of Care
S RGN=1
; Clean up labs
NEW DA,IENS,CIEN,TXN,TXDATA,DFLG,TAX,TREF,LBIEN,LLIST,LAB,RGN,BQQN
S CIEN=$O(^BQI(90506.5,"B","HIV QoC","")) I CIEN="" Q
S DA=0,DA(1)=CIEN
F S DA=$O(^BQI(90506.5,CIEN,10,DA)) Q:'DA D
. S IENS=$$IENS^DILF(.DA)
. S BQIUPD(90506.51,IENS,.09)=1
I $D(BQIUPD) D FILE^DIE("","BQIUPD","ERROR")
;
S TXN=0
F S TXN=$O(^BQI(90507,RGN,20,1,10,TXN)) Q:'TXN D
. S TXDATA=^BQI(90507,RGN,20,1,10,TXN,0)
. S DFLG=+$P(TXDATA,"^",4)
. I 'DFLG Q
. S TAX=$P(TXDATA,"^",1),TREF=$NA(^TMP("BKMTAX",$J)) K @TREF
. I $P(TXDATA,"^",2)["ATXLAB" D BLD^BQITUTL(TAX,.TREF,"L")
. I $P(TXDATA,"^",2)'["ATXLAB" D BLD^BQITUTL(TAX,.TREF,"")
. S LBIEN=""
. F S LBIEN=$O(@TREF@(LBIEN)) Q:LBIEN="" D
.. ;I $T(@("DECON^BKMCMLBP"))'="" D DECON^BKMCMLBP(LBIEN,.LLIST)
.. ;I $T(@("LBT^BKMCMLBP"))'="" D LBT^BKMCMLBP(.LLIST)
.. K LLIST
.. ;
K @TREF
Q
BQINIGH4 ;GDIT/HS/ALA-Nightly process ; 02 Jan 2015 12:21 PM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;;May 24, 2016;Build 27
+2 ;
+3 ;
REG ;EP - Check for register updates and apply in iCare
+1 ; Process register records into tags
+2 NEW REGIEN,RDATA,TAG,FILE,FIELD,XREF,STFILE,STFLD,STEX,SUBREG,GLBREF,GLBNOD
+3 NEW DFN,RIEN,QFL,DATE,TGNM,PSTAT,DATA
+4 SET REGIEN=0
+5 FOR
SET REGIEN=$ORDER(^BQI(90507,REGIEN))
IF 'REGIEN
QUIT
Begin DoDot:1
+6 SET RDATA=^BQI(90507,REGIEN,0)
+7 ; If the register is inactive, quit
+8 IF $PIECE(RDATA,U,8)=1
QUIT
+9 ; Check if register is associated with a tag, if there isn't one, quit
+10 SET TAG=$ORDER(^BQI(90506.2,"AD",REGIEN,""))
IF TAG=""
QUIT
+11 SET FILE=$PIECE(RDATA,U,7)
SET FIELD=$PIECE(RDATA,U,5)
SET XREF=$PIECE(RDATA,U,6)
+12 SET STFILE=$PIECE(RDATA,U,15)
SET STFLD=$PIECE(RDATA,U,14)
SET STEX=$GET(^BQI(90507,REGIEN,1))
+13 SET SUBREG=$PIECE(RDATA,U,9)
+14 SET GLBREF=$$ROOT^DILFD(FILE,"")_XREF_")"
+15 SET GLBNOD=$$ROOT^DILFD(FILE,"",1)
+16 IF GLBNOD=""
QUIT
+17 ;
+18 IF '$DATA(@GLBNOD@(0))
QUIT
+19 ;
+20 SET DFN=""
+21 FOR
SET DFN=$ORDER(@GLBREF@(DFN))
IF DFN=""
QUIT
Begin DoDot:2
+22 ; If patient is deceased, quit
+23 IF $PIECE($GET(^DPT(DFN,.35)),U,1)'=""
QUIT
+24 ; If patient has no active HRNs, quit
+25 IF '$$HRN^BQIUL1(DFN)
QUIT
+26 ; If patient has no visit in last 3 years, quit
+27 IF '$$VTHR^BQIUL1(DFN)
QUIT
+28 ;
+29 IF $GET(SUBREG)'=""
SET QFL=0
Begin DoDot:3
+30 IF FILE'=9002241
QUIT
+31 SET RIEN=""
+32 FOR
SET RIEN=$ORDER(@GLBREF@(DFN,RIEN))
IF RIEN=""
QUIT
Begin DoDot:4
+33 IF $PIECE($GET(@GLBNOD@(RIEN,0)),U,5)=SUBREG
SET QFL=1
SET IENS=RIEN
End DoDot:4
End DoDot:3
IF 'QFL
QUIT
+34 ; Check register status
+35 IF $GET(SUBREG)=""
SET IENS=$ORDER(@GLBREF@(DFN,""))
+36 IF STEX'=""
XECUTE STEX
IF '$DATA(IENS)
QUIT
+37 SET PSTAT=$$GET1^DIQ(STFILE,IENS,STFLD,"I")
+38 SET DATE=$PIECE($GET(^BQIPAT(DFN,20,TAG,0)),U,2)
+39 IF $ORDER(^BQIREG("C",DFN,TAG,""))'=""
QUIT
+40 IF PSTAT="U"!(PSTAT="")
Begin DoDot:3
+41 ; If patient is already tagged, quit
+42 IF $ORDER(^BQIPAT(DFN,20,TAG,0))'=""
QUIT
+43 ; else build a "proposed" record
+44 DO EN^BQITDPRC(.DATA,DFN,TAG,"P",DATE,"NIGHTLY JOB",8,"Register status is "_PSTAT)
QUIT
End DoDot:3
QUIT
+45 IF PSTAT="D"
QUIT
+46 IF PSTAT="I"
Begin DoDot:3
+47 ; If the patient was not tagged and is inactive on register, quit
+48 IF $ORDER(^BQIPAT(DFN,20,TAG,0))=""
QUIT
+49 ; If the patient was tagged and is inactive on register
+50 DO EN^BQITDPRC(.DATA,DFN,TAG,"P",DATE,"NIGHTLY JOB",8,"Register status is "_PSTAT)
QUIT
End DoDot:3
QUIT
+51 DO EN^BQITDPRC(.DATA,DFN,TAG,"A",DATE,"NIGHTLY JOB",8,"Register status is "_PSTAT)
+52 ; Remove any temporary BQIPAT data
+53 NEW DA,DIK
+54 SET DA(1)=DFN
SET DA=TAG
SET DIK="^BQIPAT("_DA(1)_",20,"
+55 DO ^DIK
End DoDot:2
End DoDot:1
+56 QUIT
+57 ;
RTAX ;EP - Check for report taxonomies
+1 ;determine if any taxonomies need deconstruction for Source and layouts
+2 ; For HIV/AIDS Quality of Care
+3 SET RGN=1
+4 ; Clean up labs
+5 NEW DA,IENS,CIEN,TXN,TXDATA,DFLG,TAX,TREF,LBIEN,LLIST,LAB,RGN,BQQN
+6 SET CIEN=$ORDER(^BQI(90506.5,"B","HIV QoC",""))
IF CIEN=""
QUIT
+7 SET DA=0
SET DA(1)=CIEN
+8 FOR
SET DA=$ORDER(^BQI(90506.5,CIEN,10,DA))
IF 'DA
QUIT
Begin DoDot:1
+9 SET IENS=$$IENS^DILF(.DA)
+10 SET BQIUPD(90506.51,IENS,.09)=1
End DoDot:1
+11 IF $DATA(BQIUPD)
DO FILE^DIE("","BQIUPD","ERROR")
+12 ;
+13 SET TXN=0
+14 FOR
SET TXN=$ORDER(^BQI(90507,RGN,20,1,10,TXN))
IF 'TXN
QUIT
Begin DoDot:1
+15 SET TXDATA=^BQI(90507,RGN,20,1,10,TXN,0)
+16 SET DFLG=+$PIECE(TXDATA,"^",4)
+17 IF 'DFLG
QUIT
+18 SET TAX=$PIECE(TXDATA,"^",1)
SET TREF=$NAME(^TMP("BKMTAX",$JOB))
KILL @TREF
+19 IF $PIECE(TXDATA,"^",2)["ATXLAB"
DO BLD^BQITUTL(TAX,.TREF,"L")
+20 IF $PIECE(TXDATA,"^",2)'["ATXLAB"
DO BLD^BQITUTL(TAX,.TREF,"")
+21 SET LBIEN=""
+22 FOR
SET LBIEN=$ORDER(@TREF@(LBIEN))
IF LBIEN=""
QUIT
Begin DoDot:2
+23 ;I $T(@("DECON^BKMCMLBP"))'="" D DECON^BKMCMLBP(LBIEN,.LLIST)
+24 ;I $T(@("LBT^BKMCMLBP"))'="" D LBT^BKMCMLBP(.LLIST)
+25 KILL LLIST
+26 ;
End DoDot:2
End DoDot:1
+27 KILL @TREF
+28 QUIT
