BQINIGH3 ;GDIT/HS/ALA-Nightly job continued ; 26 Apr 2013 11:07 AM
;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
;
JBC ;EP - Check on MU jobs
NEW ZTSK,NJOB,YJOB,NXDT
S NJOB=$P($G(^BQI(90508,1,12)),U,5)
S YJOB=$P($G(^BQI(90508,1,12)),U,6)
;
; check on ninety day job
I NJOB'="" D
. S ZTSK=NJOB D STAT^%ZTLOAD
. I $G(ZTSK(2))'="Active: Pending" D
.. I $G(ZTSK(2))="Active: Running" Q
.. I $G(ZTSK(2))="Inactive: Finished" S $P(^BQI(90508,1,12),U,5)="" D Q
... D JBD
... D NJB
.. I $G(ZTSK(2))="Inactive: Interrupted"!($G(ZTSK(2))="Undefined") D
... I $P($G(^BQI(90508,1,12)),U,3)=0 D JBD,NJB Q
... S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
... S ZTDESC="MU CQ Continue Compile",ZTRTN="NIN^BQITASK6",ZTIO=""
... D ^%ZTLOAD
... S BQIUPD(90508,"1,",12.05)=ZTSK
... D FILE^DIE("","BQIUPD","ERROR")
;
I YJOB'="" D
. S ZTSK=YJOB D STAT^%ZTLOAD
. I $G(ZTSK(2))'="Active: Pending" D
.. I $G(ZTSK(2))="Active: Running" Q
.. I $G(ZTSK(2))="Inactive: Finished" S $P(^BQI(90508,1,12),U,6)="" D Q
... D JBDY
... D NJBY
.. I $G(ZTSK(2))="Inactive: Interrupted"!($G(ZTSK(2))="Undefined") D
... I $P($G(^BQI(90508,1,12)),U,4)=0 D JBDY,NJBY Q
... S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
... S ZTDESC="MU Performance Continue Monthly Compile",ZTRTN="NIN^BQITASK7",ZTIO=""
... D ^%ZTLOAD
... S BQIUPD(90508,"1,",12.06)=ZTSK
... D FILE^DIE("","BQIUPD","ERROR")
; If job does not have a task number, quit
I NJOB="" D JBD,NJB
I YJOB="" D JBDY,NJBY
Q
;
JBD ;EP - Job date
NEW BMDT
S BMDT=$P(^BQI(90508,1,12),U,9),BMDT=$$FMADD^XLFDT(BMDT,1)
I $D(^XTMP("BQIMMON",BMDT)) K ^XTMP("BQIMMON",BMDT)
I $O(^XTMP("BQIMMON",""),-1)="" K ^XTMP("BQIMMON") Q
Q
;
JBDY ;EP
NEW BMDT
S BMDT=$P(^BQI(90508,1,9),U,2),BMDT=$$FMADD^XLFDT(BMDT,1)
I $D(^XTMP("BQIMMONP",BMDT)) K ^XTMP("BQIMMONP",BMDT)
I $O(^XTMP("BQIMMONP",""),-1)="" K ^XTMP("BQIMMONP") Q
Q
;
NJB ;EP - Next job
I $P($G(^BQI(90508,1,12)),U,3)=0 D
. ; Get next date to process
. S NXDT=$O(^XTMP("BQIMMON",""),-1) I 'NXDT Q
. D CQ^BQIMUMON(NXDT)
Q
;
NJBY ;EP
I $P($G(^BQI(90508,1,12)),U,4)=0 D
. ; Get next date to process
. S NXDT=$O(^XTMP("BQIMMONP",""),-1) I 'NXDT Q
. D PF^BQIMUMON(NXDT)
Q
;
IJB(IPDATE) ;EP - IPC Job check
NEW ZTSK,IJOB
S IJOB=$P($G(^BQI(90508,1,11)),U,4)
; If IPC job is blank set up task
I IJOB="" D INJ Q
;
; check on IPC monthly job
I IJOB'="" D
. S ZTSK=IJOB D STAT^%ZTLOAD
. I $G(ZTSK(2))'["Pending" D
.. I $G(ZTSK(2))["Running" Q
.. I $G(ZTSK(2))["Finished" S $P(^BQI(90508,1,11),U,4)="" Q
.. I $G(ZTSK(2))["Undefined" D Q
... I $P($G(^BQI(90508,1,11)),U,3)="",'$D(^%ZTSK(ZTSK)) S $P(^BQI(90508,1,11),U,4)="" Q
... I $P($G(^BQI(90508,1,11)),U,3)'="" S IPDATE=$P($G(^BQI(90508,1,11)),U,5) D INJ
.. I $G(ZTSK(2))["Inactive"!($G(ZTSK(2))["Interrupted") D
... S IPDATE=$P($G(^BQI(90508,1,11)),U,5) D INJ
Q
;
INJ ;EP - New IPC job
NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
S ZTDESC="IPC Monthly Compile",ZTRTN="EN^BQIIPMNU",ZTIO="",ZTSAVE("BQDATE")=$G(IPDATE)
D ^%ZTLOAD
S BQIUPD(90508,"1,",11.04)=ZTSK
D FILE^DIE("","BQIUPD","ERROR")
Q
;
POV ;EP - Set up POV table
NEW DN,CD,NN,CNT
K ^XTMP("BQIPOV")
S ^XTMP("BQIPOV",0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"POV Table Values"
S DN=0,II=0
F S DN=$O(^AUPNVPOV("B",DN)) Q:DN="" D
. I $G(^ICD9(DN,0))="" Q
. S NN="",CNT=0 F S NN=$O(^AUPNVPOV("B",DN,NN)) Q:NN="" D
.. NEW VIS
.. S VIS=$P(^AUPNVPOV(NN,0),"^",3) I VIS="" Q
.. Q:"DXCT"[$P(^AUPNVSIT(VIS,0),U,7)
.. S CNT=CNT+1
. S II=II+1,^XTMP("BQIPOV",II)=DN_U_$$VST^ICDCODE(DN,"",80)_U_$$CODEC^ICDCODE(DN,80)_U_CNT
. S ^XTMP("BQIPOV","Z",CNT,DN)=$$VST^ICDCODE(DN,"",80)_U_$$CODEC^ICDCODE(DN,80)
Q
;
SNO ;EP - Set up SNOMED table
D SN^BQISNOMS
Q
;
JBB(TYP) ;EP - Job off counts
NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
S ZTDESC="Count Compile",ZTRTN=TYP_"^BQINIGH3",ZTIO=""
D ^%ZTLOAD
Q
;
WK ;EP - Weekly IPC job
NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
S ZTDESC="IPC Weekly Compile",ZTRTN="EN^BQIIPWKL",ZTIO=""
D ^%ZTLOAD
S BQIUPD(90508,"1,",11.06)=ZTSK
D FILE^DIE("","BQIUPD","ERROR")
Q
BQINIGH3 ;GDIT/HS/ALA-Nightly job continued ; 26 Apr 2013 11:07 AM
+1 ;;2.7;ICARE MANAGEMENT SYSTEM;;Dec 19, 2017;Build 23
+2 ;
JBC ;EP - Check on MU jobs
+1 NEW ZTSK,NJOB,YJOB,NXDT
+2 SET NJOB=$PIECE($GET(^BQI(90508,1,12)),U,5)
+3 SET YJOB=$PIECE($GET(^BQI(90508,1,12)),U,6)
+4 ;
+5 ; check on ninety day job
+6 IF NJOB'=""
Begin DoDot:1
+7 SET ZTSK=NJOB
DO STAT^%ZTLOAD
+8 IF $GET(ZTSK(2))'="Active: Pending"
Begin DoDot:2
+9 IF $GET(ZTSK(2))="Active: Running"
QUIT
+10 IF $GET(ZTSK(2))="Inactive: Finished"
SET $PIECE(^BQI(90508,1,12),U,5)=""
Begin DoDot:3
+11 DO JBD
+12 DO NJB
End DoDot:3
QUIT
+13 IF $GET(ZTSK(2))="Inactive: Interrupted"!($GET(ZTSK(2))="Undefined")
Begin DoDot:3
+14 IF $PIECE($GET(^BQI(90508,1,12)),U,3)=0
DO JBD
DO NJB
QUIT
+15 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
+16 SET ZTDESC="MU CQ Continue Compile"
SET ZTRTN="NIN^BQITASK6"
SET ZTIO=""
+17 DO ^%ZTLOAD
+18 SET BQIUPD(90508,"1,",12.05)=ZTSK
+19 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:3
End DoDot:2
End DoDot:1
+20 ;
+21 IF YJOB'=""
Begin DoDot:1
+22 SET ZTSK=YJOB
DO STAT^%ZTLOAD
+23 IF $GET(ZTSK(2))'="Active: Pending"
Begin DoDot:2
+24 IF $GET(ZTSK(2))="Active: Running"
QUIT
+25 IF $GET(ZTSK(2))="Inactive: Finished"
SET $PIECE(^BQI(90508,1,12),U,6)=""
Begin DoDot:3
+26 DO JBDY
+27 DO NJBY
End DoDot:3
QUIT
+28 IF $GET(ZTSK(2))="Inactive: Interrupted"!($GET(ZTSK(2))="Undefined")
Begin DoDot:3
+29 IF $PIECE($GET(^BQI(90508,1,12)),U,4)=0
DO JBDY
DO NJBY
QUIT
+30 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
+31 SET ZTDESC="MU Performance Continue Monthly Compile"
SET ZTRTN="NIN^BQITASK7"
SET ZTIO=""
+32 DO ^%ZTLOAD
+33 SET BQIUPD(90508,"1,",12.06)=ZTSK
+34 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:3
End DoDot:2
End DoDot:1
+35 ; If job does not have a task number, quit
+36 IF NJOB=""
DO JBD
DO NJB
+37 IF YJOB=""
DO JBDY
DO NJBY
+38 QUIT
+39 ;
JBD ;EP - Job date
+1 NEW BMDT
+2 SET BMDT=$PIECE(^BQI(90508,1,12),U,9)
SET BMDT=$$FMADD^XLFDT(BMDT,1)
+3 IF $DATA(^XTMP("BQIMMON",BMDT))
KILL ^XTMP("BQIMMON",BMDT)
+4 IF $ORDER(^XTMP("BQIMMON",""),-1)=""
KILL ^XTMP("BQIMMON")
QUIT
+5 QUIT
+6 ;
JBDY ;EP
+1 NEW BMDT
+2 SET BMDT=$PIECE(^BQI(90508,1,9),U,2)
SET BMDT=$$FMADD^XLFDT(BMDT,1)
+3 IF $DATA(^XTMP("BQIMMONP",BMDT))
KILL ^XTMP("BQIMMONP",BMDT)
+4 IF $ORDER(^XTMP("BQIMMONP",""),-1)=""
KILL ^XTMP("BQIMMONP")
QUIT
+5 QUIT
+6 ;
NJB ;EP - Next job
+1 IF $PIECE($GET(^BQI(90508,1,12)),U,3)=0
Begin DoDot:1
+2 ; Get next date to process
+3 SET NXDT=$ORDER(^XTMP("BQIMMON",""),-1)
IF 'NXDT
QUIT
+4 DO CQ^BQIMUMON(NXDT)
End DoDot:1
+5 QUIT
+6 ;
NJBY ;EP
+1 IF $PIECE($GET(^BQI(90508,1,12)),U,4)=0
Begin DoDot:1
+2 ; Get next date to process
+3 SET NXDT=$ORDER(^XTMP("BQIMMONP",""),-1)
IF 'NXDT
QUIT
+4 DO PF^BQIMUMON(NXDT)
End DoDot:1
+5 QUIT
+6 ;
IJB(IPDATE) ;EP - IPC Job check
+1 NEW ZTSK,IJOB
+2 SET IJOB=$PIECE($GET(^BQI(90508,1,11)),U,4)
+3 ; If IPC job is blank set up task
+4 IF IJOB=""
DO INJ
QUIT
+5 ;
+6 ; check on IPC monthly job
+7 IF IJOB'=""
Begin DoDot:1
+8 SET ZTSK=IJOB
DO STAT^%ZTLOAD
+9 IF $GET(ZTSK(2))'["Pending"
Begin DoDot:2
+10 IF $GET(ZTSK(2))["Running"
QUIT
+11 IF $GET(ZTSK(2))["Finished"
SET $PIECE(^BQI(90508,1,11),U,4)=""
QUIT
+12 IF $GET(ZTSK(2))["Undefined"
Begin DoDot:3
+13 IF $PIECE($GET(^BQI(90508,1,11)),U,3)=""
IF '$DATA(^%ZTSK(ZTSK))
SET $PIECE(^BQI(90508,1,11),U,4)=""
QUIT
+14 IF $PIECE($GET(^BQI(90508,1,11)),U,3)'=""
SET IPDATE=$PIECE($GET(^BQI(90508,1,11)),U,5)
DO INJ
End DoDot:3
QUIT
+15 IF $GET(ZTSK(2))["Inactive"!($GET(ZTSK(2))["Interrupted")
Begin DoDot:3
+16 SET IPDATE=$PIECE($GET(^BQI(90508,1,11)),U,5)
DO INJ
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
INJ ;EP - New IPC job
+1 NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD
+2 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
+3 SET ZTDESC="IPC Monthly Compile"
SET ZTRTN="EN^BQIIPMNU"
SET ZTIO=""
SET ZTSAVE("BQDATE")=$GET(IPDATE)
+4 DO ^%ZTLOAD
+5 SET BQIUPD(90508,"1,",11.04)=ZTSK
+6 DO FILE^DIE("","BQIUPD","ERROR")
+7 QUIT
+8 ;
POV ;EP - Set up POV table
+1 NEW DN,CD,NN,CNT
+2 KILL ^XTMP("BQIPOV")
+3 SET ^XTMP("BQIPOV",0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"POV Table Values"
+4 SET DN=0
SET II=0
+5 FOR
SET DN=$ORDER(^AUPNVPOV("B",DN))
IF DN=""
QUIT
Begin DoDot:1
+6 IF $GET(^ICD9(DN,0))=""
QUIT
+7 SET NN=""
SET CNT=0
FOR
SET NN=$ORDER(^AUPNVPOV("B",DN,NN))
IF NN=""
QUIT
Begin DoDot:2
+8 NEW VIS
+9 SET VIS=$PIECE(^AUPNVPOV(NN,0),"^",3)
IF VIS=""
QUIT
+10 IF "DXCT"[$PIECE(^AUPNVSIT(VIS,0),U,7)
QUIT
+11 SET CNT=CNT+1
End DoDot:2
+12 SET II=II+1
SET ^XTMP("BQIPOV",II)=DN_U_$$VST^ICDCODE(DN,"",80)_U_$$CODEC^ICDCODE(DN,80)_U_CNT
+13 SET ^XTMP("BQIPOV","Z",CNT,DN)=$$VST^ICDCODE(DN,"",80)_U_$$CODEC^ICDCODE(DN,80)
End DoDot:1
+14 QUIT
+15 ;
SNO ;EP - Set up SNOMED table
+1 DO SN^BQISNOMS
+2 QUIT
+3 ;
JBB(TYP) ;EP - Job off counts
+1 NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD
+2 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
+3 SET ZTDESC="Count Compile"
SET ZTRTN=TYP_"^BQINIGH3"
SET ZTIO=""
+4 DO ^%ZTLOAD
+5 QUIT
+6 ;
WK ;EP - Weekly IPC job
+1 NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD
+2 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
+3 SET ZTDESC="IPC Weekly Compile"
SET ZTRTN="EN^BQIIPWKL"
SET ZTIO=""
+4 DO ^%ZTLOAD
+5 SET BQIUPD(90508,"1,",11.06)=ZTSK
+6 DO FILE^DIE("","BQIUPD","ERROR")
+7 QUIT
