BQI22P1 ;VNGT/HS/ALA-Install Program v 2.2 Patch 1 ; 25 May 2011 7:31 AM
;;2.2;ICARE MANAGEMENT SYSTEM;**1**;Jul 28, 2011;Build 25
;
PRE ; Pre-install
Q
;
POS ; Post-Install
NEW DA,BQIUPD,ERROR
S DA=1
I $$PATCH^XPDUTL("BGP*11.0*4")=1!($$PATCH^XPDUTL("BGP*11.1*1")=1) D
. S BQIUPD(90508,DA_",",.06)=1
. S BQIUPD(90508,DA_",",12.03)=0
. S BQIUPD(90508,DA_",",12.04)=0
. S BQIUPD(90508,DA_",",12.07)=1
. D FILE^DIE("","BQIUPD","ERROR")
;
D DX^BQI202PU
;
S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
S ZTDESC="Hospital CQ Compile",ZTRTN="HOS^BQI22P1",ZTIO=""
D ^%ZTLOAD
K ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
Q
;
HOS ; Hospital CQ - 90 days
I $P(^BQI(90508,1,0),U,6)=1 D
. K BGPIND
. S BGPINDT=""
. S BGPMUYF="90595.11"
. S BGPRTYPE=4,BGP0RPTH="A"
. S BGPMUT="H" ; BGPMU Hospital Measures
. S BGPRTYPE=4,BGP0RPTH="A"
. S BGPBEN=3
. S X=0 F S X=$O(^BGPMUIND(BGPMUYF,"AMS","H",X)) Q:X'=+X S BGPIND(X)=""
. S BQIGREF=$NA(^TMP("BQICQMH9",$J)) K @BQIGREF
. ; 90 days
. ; Current
. S BGPBD=$$DATE^BQIUL1("T-90"),BGPED=DT
. ; Previous
. S BGPPBD=$$DATE^BQIUL1("T-181"),BGPPED=$$DATE^BQIUL1("T-91")
. ; Baseline
. S BGPBBD=BGPPBD,BGPBED=BGPPED
. D BQI^BGPMUEHD(.BQIGREF)
. K CDEN,CNUM,CEXC,PDEN,PNUM,PEXC,CSORT,PSORT,MTOT
. S BN=""
. F S BN=$O(@BQIGREF@(BN)) Q:BN="" D
.. S I=""
.. F S I=$O(@BQIGREF@(BN,"C",I)) Q:I="" D
... I $P($G(^BGPMUIND(90596.11,I,0)),U,4)[".ED." D Q
.... S MTOT=$P(@BQIGREF@(BN,"C",I),U,2)/60
.... S CSORT(I,MTOT,BN)="",CSORT(I)=$G(CSORT(I))+1
... S CDEN(I)=$G(CDEN(I))+$P($G(@BQIGREF@(BN,"C",I)),U,1)
... S CNUM(I)=$G(CNUM(I))+$P($G(@BQIGREF@(BN,"C",I)),U,2)
... S CEXC(I)=$G(CEXC(I))+$P($G(@BQIGREF@(BN,"C",I)),U,3)
.. S I=""
.. F S I=$O(@BQIGREF@(BN,"P",I)) Q:I="" D
... I $P($G(^BGPMUIND(90596.11,I,0)),U,4)[".ED." D Q
.... S MTOT=$P(@BQIGREF@(BN,"P",I),U,2)/60
.... S PSORT(I,MTOT,BN)="",PSORT(I)=$G(PSORT(I))+1
.... S PDEN(I)=$G(PDEN(I))+$P($G(@BQIGREF@(BN,"P",I)),U,1)
.... S PNUM(I)=$G(PNUM(I))+$P($G(@BQIGREF@(BN,"P",I)),U,2)
.... S PEXC(I)=$G(PEXC(I))+$P($G(@BQIGREF@(BN,"P",I)),U,3)
.. ; For DFN set up and store individual
.. ;S PADH=$P($G(@BQIGREF@(DFN,"P",I)),U,4)
. D STORH^BQITASK5(21)
. K @BQIGREF,CSORT,PSORT
;
; Hospital CQ - 1 year
I $P(^BQI(90508,1,0),U,6)=1 D
. K BGPIND
. S BGPINDT=""
. S BGPMUYF="90595.11"
. S BGPRTYPE=4,BGP0RPTH="A"
. S BGPMUT="H" ; BGPMU Hospital Measures
. S BGPRTYPE=4,BGP0RPTH="A"
. S BGPBEN=3
. S X=0 F S X=$O(^BGPMUIND(BGPMUYF,"AMS","H",X)) Q:X'=+X S BGPIND(X)=""
. S BQIGREF=$NA(^TMP("BQICQMH1",$J)) K @BQIGREF
. ; 1 year timeframe
. ; Current
. S BGPBD=$$DATE^BQIUL1("T-365"),BGPED=DT
. ; Previous
. S BGPPBD=$$DATE^BQIUL1("T-731"),BGPPED=$$DATE^BQIUL1("T-366")
. ; Baseline
. S BGPBBD=BGPPBD,BGPBED=BGPPED
. D BQI^BGPMUEHD(.BQIGREF)
. K CDEN,CNUM,CEXC,PDEN,PNUM,PEXC,CSORT,PSORT,MTOT
. S BN=""
. F S BN=$O(@BQIGREF@(BN)) Q:BN="" D
.. S I=""
.. F S I=$O(@BQIGREF@(BN,"C",I)) Q:I="" D
... I $P($G(^BGPMUIND(90596.11,I,0)),U,4)[".ED." D Q
.... S MTOT=$P(@BQIGREF@(BN,"C",I),U,2)/60
.... S CSORT(I,MTOT,BN)="",CSORT(I)=$G(CSORT(I))+1
... S CDEN(I)=$G(CDEN(I))+$P($G(@BQIGREF@(BN,"C",I)),U,1)
... S CNUM(I)=$G(CNUM(I))+$P($G(@BQIGREF@(BN,"C",I)),U,2)
... S CEXC(I)=$G(CEXC(I))+$P($G(@BQIGREF@(BN,"C",I)),U,3)
.. S I=""
.. F S I=$O(@BQIGREF@(BN,"P",I)) Q:I="" D
... I $P($G(^BGPMUIND(90596.11,I,0)),U,4)[".ED." D Q
.... S MTOT=$P(@BQIGREF@(BN,"P",I),U,2)/60
.... S PSORT(I,MTOT,BN)="",PSORT(I)=$G(PSORT(I))+1
... S PDEN(I)=$G(PDEN(I))+$P($G(@BQIGREF@(BN,"P",I)),U,1)
... S PNUM(I)=$G(PNUM(I))+$P($G(@BQIGREF@(BN,"P",I)),U,2)
... S PEXC(I)=$G(PEXC(I))+$P($G(@BQIGREF@(BN,"P",I)),U,3)
... ; For DFN set up and store individual
... ;S PADH=$P($G(@BQIGREF@(DFN,"P",I)),U,4)
. D STORH^BQITASK5(11)
. K @BQIGREF,CSORT,PSORT
Q
BQI22P1 ;VNGT/HS/ALA-Install Program v 2.2 Patch 1 ; 25 May 2011 7:31 AM
+1 ;;2.2;ICARE MANAGEMENT SYSTEM;**1**;Jul 28, 2011;Build 25
+2 ;
PRE ; Pre-install
+1 QUIT
+2 ;
POS ; Post-Install
+1 NEW DA,BQIUPD,ERROR
+2 SET DA=1
+3 IF $$PATCH^XPDUTL("BGP*11.0*4")=1!($$PATCH^XPDUTL("BGP*11.1*1")=1)
Begin DoDot:1
+4 SET BQIUPD(90508,DA_",",.06)=1
+5 SET BQIUPD(90508,DA_",",12.03)=0
+6 SET BQIUPD(90508,DA_",",12.04)=0
+7 SET BQIUPD(90508,DA_",",12.07)=1
+8 DO FILE^DIE("","BQIUPD","ERROR")
End DoDot:1
+9 ;
+10 DO DX^BQI202PU
+11 ;
+12 SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)
+13 SET ZTDESC="Hospital CQ Compile"
SET ZTRTN="HOS^BQI22P1"
SET ZTIO=""
+14 DO ^%ZTLOAD
+15 KILL ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
+16 QUIT
+17 ;
HOS ; Hospital CQ - 90 days
+1 IF $PIECE(^BQI(90508,1,0),U,6)=1
Begin DoDot:1
+2 KILL BGPIND
+3 SET BGPINDT=""
+4 SET BGPMUYF="90595.11"
+5 SET BGPRTYPE=4
SET BGP0RPTH="A"
+6 ; BGPMU Hospital Measures
SET BGPMUT="H"
+7 SET BGPRTYPE=4
SET BGP0RPTH="A"
+8 SET BGPBEN=3
+9 SET X=0
FOR
SET X=$ORDER(^BGPMUIND(BGPMUYF,"AMS","H",X))
IF X'=+X
QUIT
SET BGPIND(X)=""
+10 SET BQIGREF=$NAME(^TMP("BQICQMH9",$JOB))
KILL @BQIGREF
+11 ; 90 days
+12 ; Current
+13 SET BGPBD=$$DATE^BQIUL1("T-90")
SET BGPED=DT
+14 ; Previous
+15 SET BGPPBD=$$DATE^BQIUL1("T-181")
SET BGPPED=$$DATE^BQIUL1("T-91")
+16 ; Baseline
+17 SET BGPBBD=BGPPBD
SET BGPBED=BGPPED
+18 DO BQI^BGPMUEHD(.BQIGREF)
+19 KILL CDEN,CNUM,CEXC,PDEN,PNUM,PEXC,CSORT,PSORT,MTOT
+20 SET BN=""
+21 FOR
SET BN=$ORDER(@BQIGREF@(BN))
IF BN=""
QUIT
Begin DoDot:2
+22 SET I=""
+23 FOR
SET I=$ORDER(@BQIGREF@(BN,"C",I))
IF I=""
QUIT
Begin DoDot:3
+24 IF $PIECE($GET(^BGPMUIND(90596.11,I,0)),U,4)[".ED."
Begin DoDot:4
+25 SET MTOT=$PIECE(@BQIGREF@(BN,"C",I),U,2)/60
+26 SET CSORT(I,MTOT,BN)=""
SET CSORT(I)=$GET(CSORT(I))+1
End DoDot:4
QUIT
+27 SET CDEN(I)=$GET(CDEN(I))+$PIECE($GET(@BQIGREF@(BN,"C",I)),U,1)
+28 SET CNUM(I)=$GET(CNUM(I))+$PIECE($GET(@BQIGREF@(BN,"C",I)),U,2)
+29 SET CEXC(I)=$GET(CEXC(I))+$PIECE($GET(@BQIGREF@(BN,"C",I)),U,3)
End DoDot:3
+30 SET I=""
+31 FOR
SET I=$ORDER(@BQIGREF@(BN,"P",I))
IF I=""
QUIT
Begin DoDot:3
+32 IF $PIECE($GET(^BGPMUIND(90596.11,I,0)),U,4)[".ED."
Begin DoDot:4
+33 SET MTOT=$PIECE(@BQIGREF@(BN,"P",I),U,2)/60
+34 SET PSORT(I,MTOT,BN)=""
SET PSORT(I)=$GET(PSORT(I))+1
+35 SET PDEN(I)=$GET(PDEN(I))+$PIECE($GET(@BQIGREF@(BN,"P",I)),U,1)
+36 SET PNUM(I)=$GET(PNUM(I))+$PIECE($GET(@BQIGREF@(BN,"P",I)),U,2)
+37 SET PEXC(I)=$GET(PEXC(I))+$PIECE($GET(@BQIGREF@(BN,"P",I)),U,3)
End DoDot:4
QUIT
End DoDot:3
+38 ; For DFN set up and store individual
+39 ;S PADH=$P($G(@BQIGREF@(DFN,"P",I)),U,4)
End DoDot:2
+40 DO STORH^BQITASK5(21)
+41 KILL @BQIGREF,CSORT,PSORT
End DoDot:1
+42 ;
+43 ; Hospital CQ - 1 year
+44 IF $PIECE(^BQI(90508,1,0),U,6)=1
Begin DoDot:1
+45 KILL BGPIND
+46 SET BGPINDT=""
+47 SET BGPMUYF="90595.11"
+48 SET BGPRTYPE=4
SET BGP0RPTH="A"
+49 ; BGPMU Hospital Measures
SET BGPMUT="H"
+50 SET BGPRTYPE=4
SET BGP0RPTH="A"
+51 SET BGPBEN=3
+52 SET X=0
FOR
SET X=$ORDER(^BGPMUIND(BGPMUYF,"AMS","H",X))
IF X'=+X
QUIT
SET BGPIND(X)=""
+53 SET BQIGREF=$NAME(^TMP("BQICQMH1",$JOB))
KILL @BQIGREF
+54 ; 1 year timeframe
+55 ; Current
+56 SET BGPBD=$$DATE^BQIUL1("T-365")
SET BGPED=DT
+57 ; Previous
+58 SET BGPPBD=$$DATE^BQIUL1("T-731")
SET BGPPED=$$DATE^BQIUL1("T-366")
+59 ; Baseline
+60 SET BGPBBD=BGPPBD
SET BGPBED=BGPPED
+61 DO BQI^BGPMUEHD(.BQIGREF)
+62 KILL CDEN,CNUM,CEXC,PDEN,PNUM,PEXC,CSORT,PSORT,MTOT
+63 SET BN=""
+64 FOR
SET BN=$ORDER(@BQIGREF@(BN))
IF BN=""
QUIT
Begin DoDot:2
+65 SET I=""
+66 FOR
SET I=$ORDER(@BQIGREF@(BN,"C",I))
IF I=""
QUIT
Begin DoDot:3
+67 IF $PIECE($GET(^BGPMUIND(90596.11,I,0)),U,4)[".ED."
Begin DoDot:4
+68 SET MTOT=$PIECE(@BQIGREF@(BN,"C",I),U,2)/60
+69 SET CSORT(I,MTOT,BN)=""
SET CSORT(I)=$GET(CSORT(I))+1
End DoDot:4
QUIT
+70 SET CDEN(I)=$GET(CDEN(I))+$PIECE($GET(@BQIGREF@(BN,"C",I)),U,1)
+71 SET CNUM(I)=$GET(CNUM(I))+$PIECE($GET(@BQIGREF@(BN,"C",I)),U,2)
+72 SET CEXC(I)=$GET(CEXC(I))+$PIECE($GET(@BQIGREF@(BN,"C",I)),U,3)
End DoDot:3
+73 SET I=""
+74 FOR
SET I=$ORDER(@BQIGREF@(BN,"P",I))
IF I=""
QUIT
Begin DoDot:3
+75 IF $PIECE($GET(^BGPMUIND(90596.11,I,0)),U,4)[".ED."
Begin DoDot:4
+76 SET MTOT=$PIECE(@BQIGREF@(BN,"P",I),U,2)/60
+77 SET PSORT(I,MTOT,BN)=""
SET PSORT(I)=$GET(PSORT(I))+1
End DoDot:4
QUIT
+78 SET PDEN(I)=$GET(PDEN(I))+$PIECE($GET(@BQIGREF@(BN,"P",I)),U,1)
+79 SET PNUM(I)=$GET(PNUM(I))+$PIECE($GET(@BQIGREF@(BN,"P",I)),U,2)
+80 SET PEXC(I)=$GET(PEXC(I))+$PIECE($GET(@BQIGREF@(BN,"P",I)),U,3)
+81 ; For DFN set up and store individual
+82 ;S PADH=$P($G(@BQIGREF@(DFN,"P",I)),U,4)
End DoDot:3
End DoDot:2
+83 DO STORH^BQITASK5(11)
+84 KILL @BQIGREF,CSORT,PSORT
End DoDot:1
+85 QUIT