BKMQQCRD ;VNGT/HS/ALA - ARV Stability ; 03 May 2010 7:57 AM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
;
;
BEG ;
NEW TOTADH,TOTAPP,TOTAUN,TOTUST,TOTEST,TOTTHO,NP1,NP2,NP3,PER,ARVDT,TOTDOC
NEW HP1,HP2,HP3,PP1,PP2,PP3,SP1,SP2,SP3,UP1,UP2,UP3,EP1,EP2,EP3,TP1,TP2,TP3
;
D DTR^BKMQQCRU(EDATE\1)
;
; Adherence
S TOTADH=$P(GLOB,")")_",""HIVCHK"",""ARVADHCNT"")"
; Appropriate
S TOTAPP=$P(GLOB,")")_",""HIVCHK"",""ARVAPPCNT"")"
; Unstable
S TOTUST=$P(GLOB,")")_",""HIVCHK"",""ARVUNPCNT"")"
; Stable
S TOTAUN=$P(GLOB,")")_",""HIVCHK"",""ARVSTPCNT"")"
; End Stage
S TOTEST=$P(GLOB,")")_",""HIVCHK"",""ARVESPCNT"")"
; No therapeutic
S TOTTHO=$P(GLOB,")")_",""HIVCHK"",""ARVTOPCNT"")"
; Documentation Assessment
S TOTDOC=$P(GLOB,")")_",""HIVCHK"",""ARVPCNT"")"
S (@TOTADH,@TOTAPP,@TOTAUN,@TOTUST,@TOTADH,@TOTTHO,@TOTDOC)=0
;
S BKMDFN=0
F S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN D
. D APP^BKMQQCRV(BKMDFN,(EDATE\1))
. S (HP1,HP2,HP3,PP1,PP2,PP3,TP1,TP2,TP3)=0
. S (SP1,SP2,SP3,UP1,UP2,UP3,EP1,EP2,EP3,NP1,NP2,NP3)=0
. K ARVSTAB
. D ADAP(BKMDFN) D
.. Q:'$D(ARVSTAB)
.. F PER="P1","P2","P3" D
... S ARVDT=$O(ARVSTAB(PER,""),-1)
... I ARVDT'="" S STAT=ARVSTAB(PER,ARVDT) D UPD(STAT,PER)
.. S @TOTADH@("P1")=$G(@TOTADH@("P1"))+HP1
.. S @TOTADH@("P2")=$G(@TOTADH@("P2"))+HP2
.. S @TOTADH@("P3")=$G(@TOTADH@("P3"))+HP3
.. S @TOTAPP@("P1")=$G(@TOTAPP@("P1"))+PP1
.. S @TOTAPP@("P2")=$G(@TOTAPP@("P2"))+PP2
.. S @TOTAPP@("P3")=$G(@TOTAPP@("P3"))+PP3
.. S @TOTAUN@("P1")=$G(@TOTAUN@("P1"))+SP1
.. S @TOTAUN@("P2")=$G(@TOTAUN@("P2"))+SP2
.. S @TOTAUN@("P3")=$G(@TOTAUN@("P3"))+SP3
.. S @TOTUST@("P1")=$G(@TOTUST@("P1"))+UP1
.. S @TOTUST@("P2")=$G(@TOTUST@("P2"))+UP2
.. S @TOTUST@("P3")=$G(@TOTUST@("P3"))+UP3
.. S @TOTEST@("P1")=$G(@TOTEST@("P1"))+EP1
.. S @TOTEST@("P2")=$G(@TOTEST@("P2"))+EP2
.. S @TOTEST@("P3")=$G(@TOTEST@("P3"))+EP3
.. S @TOTTHO@("P1")=$G(@TOTTHO@("P1"))+NP1
.. S @TOTTHO@("P2")=$G(@TOTTHO@("P2"))+NP2
.. S @TOTTHO@("P3")=$G(@TOTTHO@("P3"))+NP3
.. I HP1'=0,PP1'=0,TP1'=0 S @TOTDOC@("P1")=$G(@TOTDOC@("P1"))+1
.. I HP2'=0,PP2'=0,TP2'=0 S @TOTDOC@("P2")=$G(@TOTDOC@("P2"))+1
.. I HP3'=0,PP3'=0,TP3'=0 S @TOTDOC@("P3")=$G(@TOTDOC@("P3"))+1
K ARVSTAB
Q
;
STB(BKMDFN) ; Stable
NEW ALL,STABLE,MRCV,MRCDT,PRVDT,LIEN,RESULT,MRESULT,PRESULT,GOOD
D LB^BKMQQCRU(.ALL)
S STABLE=0
; Most recent Viral load is less than 400 copies /ml
S MRCV=0,TOTAL=0
S MRCDT=$O(ALL("VIRAL",BKMDFN,""),-1),PRVDT=$O(ALL("VIRAL",BKMDFN,MRCDT),-1)
I MRCDT'="" D
. S LIEN=$O(ALL("VIRAL",BKMDFN,MRCDT,"")),RESULT=$P(ALL("VIRAL",BKMDFN,MRCDT,LIEN),U,1)
. S PER=$P(ALL("VIRAL",BKMDFN,MRCDT,LIEN),U,2),MRESULT=RESULT
. I RESULT="<400" S STABLE=1 Q
. I RESULT["<",$$STRIP^XLFSTR(RESULT,"<")<400 S STABLE=1_U_1 Q
. I RESULT[">",$$STRIP^XLFSTR(RESULT,">")<400 S STABLE=1_U_"1A"
. I RESULT<400 S STABLE=1 Q
I STABLE S GOOD(PER)=$G(GOOD(PER))+1
Q
;
ARV(BKMDFN) ; ARV Regimen
NEW TYPE,BKMARV
S BKMARV=0
F TYPE="ARVM03","ARVM02","ARVM01","ARVM05","ARVM09","ARVM10","ARVM11","ARVM12","ARVM13" I $D(@GLOB@("HIVCHK",BKMDFN,TYPE)) S BKMARV=1
Q BKMARV
;
ADAP(BKMDFN) ; Patient Adherence and Appropriate
NEW HDATE,STDT
S BKMIEN=$$BKMIEN^BKMIXX3(BKMDFN) I BKMIEN="" Q
S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
; Appropriate
S STDT=REVPER-.005
F S STDT=$O(^BKM(90451,BKMIEN,1,BKMREG,40,"B",STDT)) Q:STDT=""!(STDT\1>EDATE) D
. S HDATE=$$FMTH^XLFDT((STDT\1),1)
. I HDATE'>HP1B,HDATE'<HP1E D
.. I PP1=0 S PP1=PP1+1
. I HDATE'>HP2B,HDATE'<HP2E D
.. I PP2=0 S PP2=PP2+1
. I HDATE'>HP3B,HDATE'<HP3E D
.. I PP3=0 S PP3=PP3+1
; Adherence
S STDT=REVPER-.005
F S STDT=$O(^BKM(90451,BKMIEN,1,BKMREG,50,"B",STDT)) Q:STDT=""!(STDT\1>EDATE) D
. S HDATE=$$FMTH^XLFDT((STDT\1),1)
. I HDATE'>HP1B,HDATE'<HP1E D
.. I HP1=0 S HP1=HP1+1
. I HDATE'>HP2B,HDATE'<HP2E D
.. I HP2=0 S HP2=HP2+1
. I HDATE'>HP3B,HDATE'<HP3E D
.. I HP3=0 S HP3=HP3+1
;
S RESULT=0,QFL=0,STDT=EDATE+.005
F S STDT=$O(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT),-1) Q:STDT=""!(STDT<REVPER) D Q:QFL
. S IEN=""
. F S IEN=$O(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT,IEN),-1) Q:IEN="" D Q:QFL
.. S STAT=$P(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,0),U,2)
.. ;S:Stable;U:Unstable;E:End Stage;N:No other
.. S HDATE=$$FMTH^XLFDT((STDT\1),1)
.. I HDATE'>HP1B,HDATE'<HP1E S ARVSTAB("P1",STDT)=STAT
.. I HDATE'>HP2B,HDATE'<HP2E S ARVSTAB("P2",STDT)=STAT
.. I HDATE'>HP3B,HDATE'<HP3E S ARVSTAB("P3",STDT)=STAT
Q
;
UPD(STAT,PER) ;EP
I STAT="S" D
. I PER="P1" S SP1=SP1+1
. I PER="P2" S SP2=SP2+1
. I PER="P3" S SP3=SP3+1
I STAT="U" D
. I PER="P1" S UP1=UP1+1
. I PER="P2" S UP2=UP2+1
. I PER="P3" S UP3=UP3+1
I STAT="E" D
. I PER="P1" S EP1=EP1+1
. I PER="P2" S EP2=EP2+1
. I PER="P3" S EP3=EP3+1
I STAT="N" D
. I PER="P1" S NP1=NP1+1
. I PER="P2" S NP2=NP2+1
. I PER="P3" S NP3=NP3+1
;
I PER="P1" S TP1=TP1+1
I PER="P2" S TP2=TP2+1
I PER="P3" S TP3=TP3+1
Q
BKMQQCRD ;VNGT/HS/ALA - ARV Stability ; 03 May 2010 7:57 AM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 ;
BEG ;
+1 NEW TOTADH,TOTAPP,TOTAUN,TOTUST,TOTEST,TOTTHO,NP1,NP2,NP3,PER,ARVDT,TOTDOC
+2 NEW HP1,HP2,HP3,PP1,PP2,PP3,SP1,SP2,SP3,UP1,UP2,UP3,EP1,EP2,EP3,TP1,TP2,TP3
+3 ;
+4 DO DTR^BKMQQCRU(EDATE\1)
+5 ;
+6 ; Adherence
+7 SET TOTADH=$PIECE(GLOB,")")_",""HIVCHK"",""ARVADHCNT"")"
+8 ; Appropriate
+9 SET TOTAPP=$PIECE(GLOB,")")_",""HIVCHK"",""ARVAPPCNT"")"
+10 ; Unstable
+11 SET TOTUST=$PIECE(GLOB,")")_",""HIVCHK"",""ARVUNPCNT"")"
+12 ; Stable
+13 SET TOTAUN=$PIECE(GLOB,")")_",""HIVCHK"",""ARVSTPCNT"")"
+14 ; End Stage
+15 SET TOTEST=$PIECE(GLOB,")")_",""HIVCHK"",""ARVESPCNT"")"
+16 ; No therapeutic
+17 SET TOTTHO=$PIECE(GLOB,")")_",""HIVCHK"",""ARVTOPCNT"")"
+18 ; Documentation Assessment
+19 SET TOTDOC=$PIECE(GLOB,")")_",""HIVCHK"",""ARVPCNT"")"
+20 SET (@TOTADH,@TOTAPP,@TOTAUN,@TOTUST,@TOTADH,@TOTTHO,@TOTDOC)=0
+21 ;
+22 SET BKMDFN=0
+23 FOR
SET BKMDFN=$ORDER(@GLOB@("HIVCHK",BKMDFN))
IF 'BKMDFN
QUIT
Begin DoDot:1
+24 DO APP^BKMQQCRV(BKMDFN,(EDATE\1))
+25 SET (HP1,HP2,HP3,PP1,PP2,PP3,TP1,TP2,TP3)=0
+26 SET (SP1,SP2,SP3,UP1,UP2,UP3,EP1,EP2,EP3,NP1,NP2,NP3)=0
+27 KILL ARVSTAB
+28 DO ADAP(BKMDFN)
Begin DoDot:2
+29 IF '$DATA(ARVSTAB)
QUIT
+30 FOR PER="P1","P2","P3"
Begin DoDot:3
+31 SET ARVDT=$ORDER(ARVSTAB(PER,""),-1)
+32 IF ARVDT'=""
SET STAT=ARVSTAB(PER,ARVDT)
DO UPD(STAT,PER)
End DoDot:3
+33 SET @TOTADH@("P1")=$GET(@TOTADH@("P1"))+HP1
+34 SET @TOTADH@("P2")=$GET(@TOTADH@("P2"))+HP2
+35 SET @TOTADH@("P3")=$GET(@TOTADH@("P3"))+HP3
+36 SET @TOTAPP@("P1")=$GET(@TOTAPP@("P1"))+PP1
+37 SET @TOTAPP@("P2")=$GET(@TOTAPP@("P2"))+PP2
+38 SET @TOTAPP@("P3")=$GET(@TOTAPP@("P3"))+PP3
+39 SET @TOTAUN@("P1")=$GET(@TOTAUN@("P1"))+SP1
+40 SET @TOTAUN@("P2")=$GET(@TOTAUN@("P2"))+SP2
+41 SET @TOTAUN@("P3")=$GET(@TOTAUN@("P3"))+SP3
+42 SET @TOTUST@("P1")=$GET(@TOTUST@("P1"))+UP1
+43 SET @TOTUST@("P2")=$GET(@TOTUST@("P2"))+UP2
+44 SET @TOTUST@("P3")=$GET(@TOTUST@("P3"))+UP3
+45 SET @TOTEST@("P1")=$GET(@TOTEST@("P1"))+EP1
+46 SET @TOTEST@("P2")=$GET(@TOTEST@("P2"))+EP2
+47 SET @TOTEST@("P3")=$GET(@TOTEST@("P3"))+EP3
+48 SET @TOTTHO@("P1")=$GET(@TOTTHO@("P1"))+NP1
+49 SET @TOTTHO@("P2")=$GET(@TOTTHO@("P2"))+NP2
+50 SET @TOTTHO@("P3")=$GET(@TOTTHO@("P3"))+NP3
+51 IF HP1'=0
IF PP1'=0
IF TP1'=0
SET @TOTDOC@("P1")=$GET(@TOTDOC@("P1"))+1
+52 IF HP2'=0
IF PP2'=0
IF TP2'=0
SET @TOTDOC@("P2")=$GET(@TOTDOC@("P2"))+1
+53 IF HP3'=0
IF PP3'=0
IF TP3'=0
SET @TOTDOC@("P3")=$GET(@TOTDOC@("P3"))+1
End DoDot:2
End DoDot:1
+54 KILL ARVSTAB
+55 QUIT
+56 ;
STB(BKMDFN) ; Stable
+1 NEW ALL,STABLE,MRCV,MRCDT,PRVDT,LIEN,RESULT,MRESULT,PRESULT,GOOD
+2 DO LB^BKMQQCRU(.ALL)
+3 SET STABLE=0
+4 ; Most recent Viral load is less than 400 copies /ml
+5 SET MRCV=0
SET TOTAL=0
+6 SET MRCDT=$ORDER(ALL("VIRAL",BKMDFN,""),-1)
SET PRVDT=$ORDER(ALL("VIRAL",BKMDFN,MRCDT),-1)
+7 IF MRCDT'=""
Begin DoDot:1
+8 SET LIEN=$ORDER(ALL("VIRAL",BKMDFN,MRCDT,""))
SET RESULT=$PIECE(ALL("VIRAL",BKMDFN,MRCDT,LIEN),U,1)
+9 SET PER=$PIECE(ALL("VIRAL",BKMDFN,MRCDT,LIEN),U,2)
SET MRESULT=RESULT
+10 IF RESULT="<400"
SET STABLE=1
QUIT
+11 IF RESULT["<"
IF $$STRIP^XLFSTR(RESULT,"<")<400
SET STABLE=1_U_1
QUIT
+12 IF RESULT[">"
IF $$STRIP^XLFSTR(RESULT,">")<400
SET STABLE=1_U_"1A"
+13 IF RESULT<400
SET STABLE=1
QUIT
End DoDot:1
+14 IF STABLE
SET GOOD(PER)=$GET(GOOD(PER))+1
+15 QUIT
+16 ;
ARV(BKMDFN) ; ARV Regimen
+1 NEW TYPE,BKMARV
+2 SET BKMARV=0
+3 FOR TYPE="ARVM03","ARVM02","ARVM01","ARVM05","ARVM09","ARVM10","ARVM11","ARVM12","ARVM13"
IF $DATA(@GLOB@("HIVCHK",BKMDFN,TYPE))
SET BKMARV=1
+4 QUIT BKMARV
+5 ;
ADAP(BKMDFN) ; Patient Adherence and Appropriate
+1 NEW HDATE,STDT
+2 SET BKMIEN=$$BKMIEN^BKMIXX3(BKMDFN)
IF BKMIEN=""
QUIT
+3 SET BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
+4 ; Appropriate
+5 SET STDT=REVPER-.005
+6 FOR
SET STDT=$ORDER(^BKM(90451,BKMIEN,1,BKMREG,40,"B",STDT))
IF STDT=""!(STDT\1>EDATE)
QUIT
Begin DoDot:1
+7 SET HDATE=$$FMTH^XLFDT((STDT\1),1)
+8 IF HDATE'>HP1B
IF HDATE'<HP1E
Begin DoDot:2
+9 IF PP1=0
SET PP1=PP1+1
End DoDot:2
+10 IF HDATE'>HP2B
IF HDATE'<HP2E
Begin DoDot:2
+11 IF PP2=0
SET PP2=PP2+1
End DoDot:2
+12 IF HDATE'>HP3B
IF HDATE'<HP3E
Begin DoDot:2
+13 IF PP3=0
SET PP3=PP3+1
End DoDot:2
End DoDot:1
+14 ; Adherence
+15 SET STDT=REVPER-.005
+16 FOR
SET STDT=$ORDER(^BKM(90451,BKMIEN,1,BKMREG,50,"B",STDT))
IF STDT=""!(STDT\1>EDATE)
QUIT
Begin DoDot:1
+17 SET HDATE=$$FMTH^XLFDT((STDT\1),1)
+18 IF HDATE'>HP1B
IF HDATE'<HP1E
Begin DoDot:2
+19 IF HP1=0
SET HP1=HP1+1
End DoDot:2
+20 IF HDATE'>HP2B
IF HDATE'<HP2E
Begin DoDot:2
+21 IF HP2=0
SET HP2=HP2+1
End DoDot:2
+22 IF HDATE'>HP3B
IF HDATE'<HP3E
Begin DoDot:2
+23 IF HP3=0
SET HP3=HP3+1
End DoDot:2
End DoDot:1
+24 ;
+25 SET RESULT=0
SET QFL=0
SET STDT=EDATE+.005
+26 FOR
SET STDT=$ORDER(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT),-1)
IF STDT=""!(STDT<REVPER)
QUIT
Begin DoDot:1
+27 SET IEN=""
+28 FOR
SET IEN=$ORDER(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+29 SET STAT=$PIECE(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,0),U,2)
+30 ;S:Stable;U:Unstable;E:End Stage;N:No other
+31 SET HDATE=$$FMTH^XLFDT((STDT\1),1)
+32 IF HDATE'>HP1B
IF HDATE'<HP1E
SET ARVSTAB("P1",STDT)=STAT
+33 IF HDATE'>HP2B
IF HDATE'<HP2E
SET ARVSTAB("P2",STDT)=STAT
+34 IF HDATE'>HP3B
IF HDATE'<HP3E
SET ARVSTAB("P3",STDT)=STAT
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+35 QUIT
+36 ;
UPD(STAT,PER) ;EP
+1 IF STAT="S"
Begin DoDot:1
+2 IF PER="P1"
SET SP1=SP1+1
+3 IF PER="P2"
SET SP2=SP2+1
+4 IF PER="P3"
SET SP3=SP3+1
End DoDot:1
+5 IF STAT="U"
Begin DoDot:1
+6 IF PER="P1"
SET UP1=UP1+1
+7 IF PER="P2"
SET UP2=UP2+1
+8 IF PER="P3"
SET UP3=UP3+1
End DoDot:1
+9 IF STAT="E"
Begin DoDot:1
+10 IF PER="P1"
SET EP1=EP1+1
+11 IF PER="P2"
SET EP2=EP2+1
+12 IF PER="P3"
SET EP3=EP3+1
End DoDot:1
+13 IF STAT="N"
Begin DoDot:1
+14 IF PER="P1"
SET NP1=NP1+1
+15 IF PER="P2"
SET NP2=NP2+1
+16 IF PER="P3"
SET NP3=NP3+1
End DoDot:1
+17 ;
+18 IF PER="P1"
SET TP1=TP1+1
+19 IF PER="P2"
SET TP2=TP2+1
+20 IF PER="P3"
SET TP3=TP3+1
+21 QUIT
