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

BKMQQCRD.m

Go to the documentation of this file. 
  1. BKMQQCRD ;VNGT/HS/ALA - ARV Stability ; 03 May 2010  7:57 AM
  1.  ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1.  ;
  1. BEG ;
  1.  NEW TOTADH,TOTAPP,TOTAUN,TOTUST,TOTEST,TOTTHO,NP1,NP2,NP3,PER,ARVDT,TOTDOC
  1.  NEW HP1,HP2,HP3,PP1,PP2,PP3,SP1,SP2,SP3,UP1,UP2,UP3,EP1,EP2,EP3,TP1,TP2,TP3
  1.  ;
  1.  D DTR^BKMQQCRU(EDATE\1)
  1.  ;
  1.  ; Adherence
  1.  S TOTADH=$P(GLOB,")")_",""HIVCHK"",""ARVADHCNT"")"
  1.  ; Appropriate
  1.  S TOTAPP=$P(GLOB,")")_",""HIVCHK"",""ARVAPPCNT"")"
  1.  ; Unstable
  1.  S TOTUST=$P(GLOB,")")_",""HIVCHK"",""ARVUNPCNT"")"
  1.  ; Stable
  1.  S TOTAUN=$P(GLOB,")")_",""HIVCHK"",""ARVSTPCNT"")"
  1.  ; End Stage
  1.  S TOTEST=$P(GLOB,")")_",""HIVCHK"",""ARVESPCNT"")"
  1.  ; No therapeutic
  1.  S TOTTHO=$P(GLOB,")")_",""HIVCHK"",""ARVTOPCNT"")"
  1.  ; Documentation Assessment
  1.  S TOTDOC=$P(GLOB,")")_",""HIVCHK"",""ARVPCNT"")"
  1.  S (@TOTADH,@TOTAPP,@TOTAUN,@TOTUST,@TOTADH,@TOTTHO,@TOTDOC)=0
  1.  ;
  1.  S BKMDFN=0
  1.  F  S BKMDFN=$O(@GLOB@("HIVCHK",BKMDFN)) Q:'BKMDFN  D
  1.  . D APP^BKMQQCRV(BKMDFN,(EDATE\1))
  1.  . S (HP1,HP2,HP3,PP1,PP2,PP3,TP1,TP2,TP3)=0
  1.  . S (SP1,SP2,SP3,UP1,UP2,UP3,EP1,EP2,EP3,NP1,NP2,NP3)=0
  1.  . K ARVSTAB
  1.  . D ADAP(BKMDFN) D
  1.  .. Q:'$D(ARVSTAB)
  1.  .. F PER="P1","P2","P3" D
  1.  ... S ARVDT=$O(ARVSTAB(PER,""),-1)
  1.  ... I ARVDT'="" S STAT=ARVSTAB(PER,ARVDT) D UPD(STAT,PER)
  1.  .. S @TOTADH@("P1")=$G(@TOTADH@("P1"))+HP1
  1.  .. S @TOTADH@("P2")=$G(@TOTADH@("P2"))+HP2
  1.  .. S @TOTADH@("P3")=$G(@TOTADH@("P3"))+HP3
  1.  .. S @TOTAPP@("P1")=$G(@TOTAPP@("P1"))+PP1
  1.  .. S @TOTAPP@("P2")=$G(@TOTAPP@("P2"))+PP2
  1.  .. S @TOTAPP@("P3")=$G(@TOTAPP@("P3"))+PP3
  1.  .. S @TOTAUN@("P1")=$G(@TOTAUN@("P1"))+SP1
  1.  .. S @TOTAUN@("P2")=$G(@TOTAUN@("P2"))+SP2
  1.  .. S @TOTAUN@("P3")=$G(@TOTAUN@("P3"))+SP3
  1.  .. S @TOTUST@("P1")=$G(@TOTUST@("P1"))+UP1
  1.  .. S @TOTUST@("P2")=$G(@TOTUST@("P2"))+UP2
  1.  .. S @TOTUST@("P3")=$G(@TOTUST@("P3"))+UP3
  1.  .. S @TOTEST@("P1")=$G(@TOTEST@("P1"))+EP1
  1.  .. S @TOTEST@("P2")=$G(@TOTEST@("P2"))+EP2
  1.  .. S @TOTEST@("P3")=$G(@TOTEST@("P3"))+EP3
  1.  .. S @TOTTHO@("P1")=$G(@TOTTHO@("P1"))+NP1
  1.  .. S @TOTTHO@("P2")=$G(@TOTTHO@("P2"))+NP2
  1.  .. S @TOTTHO@("P3")=$G(@TOTTHO@("P3"))+NP3
  1.  .. I HP1'=0,PP1'=0,TP1'=0 S @TOTDOC@("P1")=$G(@TOTDOC@("P1"))+1
  1.  .. I HP2'=0,PP2'=0,TP2'=0 S @TOTDOC@("P2")=$G(@TOTDOC@("P2"))+1
  1.  .. I HP3'=0,PP3'=0,TP3'=0 S @TOTDOC@("P3")=$G(@TOTDOC@("P3"))+1
  1.  K ARVSTAB
  1.  Q
  1.  ;
  1. STB(BKMDFN) ; Stable
  1.  NEW ALL,STABLE,MRCV,MRCDT,PRVDT,LIEN,RESULT,MRESULT,PRESULT,GOOD
  1.  D LB^BKMQQCRU(.ALL)
  1.  S STABLE=0
  1.  ; Most recent Viral load is less than 400 copies /ml
  1.  S MRCV=0,TOTAL=0
  1.  S MRCDT=$O(ALL("VIRAL",BKMDFN,""),-1),PRVDT=$O(ALL("VIRAL",BKMDFN,MRCDT),-1)
  1.  I MRCDT'="" D
  1.  . S LIEN=$O(ALL("VIRAL",BKMDFN,MRCDT,"")),RESULT=$P(ALL("VIRAL",BKMDFN,MRCDT,LIEN),U,1)
  1.  . S PER=$P(ALL("VIRAL",BKMDFN,MRCDT,LIEN),U,2),MRESULT=RESULT
  1.  . I RESULT="<400" S STABLE=1 Q
  1.  . I RESULT["<",$$STRIP^XLFSTR(RESULT,"<")<400 S STABLE=1_U_1 Q
  1.  . I RESULT[">",$$STRIP^XLFSTR(RESULT,">")<400 S STABLE=1_U_"1A"
  1.  . I RESULT<400 S STABLE=1 Q
  1.  I STABLE S GOOD(PER)=$G(GOOD(PER))+1
  1.  Q
  1.  ;
  1. ARV(BKMDFN) ; ARV Regimen
  1.  NEW TYPE,BKMARV
  1.  S BKMARV=0
  1.  F TYPE="ARVM03","ARVM02","ARVM01","ARVM05","ARVM09","ARVM10","ARVM11","ARVM12","ARVM13" I $D(@GLOB@("HIVCHK",BKMDFN,TYPE)) S BKMARV=1
  1.  Q BKMARV
  1.  ;
  1. ADAP(BKMDFN) ; Patient Adherence and Appropriate
  1.  NEW HDATE,STDT
  1.  S BKMIEN=$$BKMIEN^BKMIXX3(BKMDFN) I BKMIEN="" Q
  1.  S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
  1.  ; Appropriate
  1.  S STDT=REVPER-.005
  1.  F  S STDT=$O(^BKM(90451,BKMIEN,1,BKMREG,40,"B",STDT)) Q:STDT=""!(STDT\1>EDATE)  D
  1.  . S HDATE=$$FMTH^XLFDT((STDT\1),1)
  1.  . I HDATE'>HP1B,HDATE'<HP1E D
  1.  .. I PP1=0 S PP1=PP1+1
  1.  . I HDATE'>HP2B,HDATE'<HP2E D
  1.  .. I PP2=0 S PP2=PP2+1
  1.  . I HDATE'>HP3B,HDATE'<HP3E D
  1.  .. I PP3=0 S PP3=PP3+1
  1.  ; Adherence
  1.  S STDT=REVPER-.005
  1.  F  S STDT=$O(^BKM(90451,BKMIEN,1,BKMREG,50,"B",STDT)) Q:STDT=""!(STDT\1>EDATE)  D
  1.  . S HDATE=$$FMTH^XLFDT((STDT\1),1)
  1.  . I HDATE'>HP1B,HDATE'<HP1E D
  1.  .. I HP1=0 S HP1=HP1+1
  1.  . I HDATE'>HP2B,HDATE'<HP2E D
  1.  .. I HP2=0 S HP2=HP2+1
  1.  . I HDATE'>HP3B,HDATE'<HP3E D
  1.  .. I HP3=0 S HP3=HP3+1
  1.  ;
  1.  S RESULT=0,QFL=0,STDT=EDATE+.005
  1.  F  S STDT=$O(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT),-1) Q:STDT=""!(STDT<REVPER)  D  Q:QFL
  1.  . S IEN=""
  1.  . F  S IEN=$O(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT,IEN),-1) Q:IEN=""  D  Q:QFL
  1.  .. S STAT=$P(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,0),U,2)
  1.  .. ;S:Stable;U:Unstable;E:End Stage;N:No other
  1.  .. S HDATE=$$FMTH^XLFDT((STDT\1),1)
  1.  .. I HDATE'>HP1B,HDATE'<HP1E S ARVSTAB("P1",STDT)=STAT
  1.  .. I HDATE'>HP2B,HDATE'<HP2E S ARVSTAB("P2",STDT)=STAT
  1.  .. I HDATE'>HP3B,HDATE'<HP3E S ARVSTAB("P3",STDT)=STAT
  1.  Q
  1.  ;
  1. UPD(STAT,PER) ;EP
  1.  I STAT="S" D
  1.  . I PER="P1" S SP1=SP1+1
  1.  . I PER="P2" S SP2=SP2+1
  1.  . I PER="P3" S SP3=SP3+1
  1.  I STAT="U" D
  1.  . I PER="P1" S UP1=UP1+1
  1.  . I PER="P2" S UP2=UP2+1
  1.  . I PER="P3" S UP3=UP3+1
  1.  I STAT="E" D
  1.  . I PER="P1" S EP1=EP1+1
  1.  . I PER="P2" S EP2=EP2+1
  1.  . I PER="P3" S EP3=EP3+1
  1.  I STAT="N" D
  1.  . I PER="P1" S NP1=NP1+1
  1.  . I PER="P2" S NP2=NP2+1
  1.  . I PER="P3" S NP3=NP3+1
  1.  ;
  1.  I PER="P1" S TP1=TP1+1
  1.  I PER="P2" S TP2=TP2+1
  1.  I PER="P3" S TP3=TP3+1
  1.  Q