BKMQQCRV ;VNGT/HS/ALA-HIVQUAL ; 09 Aug 2010 2:16 PM
;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
;
APP(BKMDFN,RPTDT) ;EP
NEW QFL,STDT,IEN,RESULT,BKMIEN,BKMREG,REVPER,CT,STAT,REG,COM,DATE,HDATE,ARV,CT,I,BKLAB
NEW UNP,UNPDT,HN,QFL
D DTR^BKMQQCRU(RPTDT)
S BKMIEN=$$BKMIEN^BKMIXX3(BKMDFN) I BKMIEN="" Q 0
S BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
S QFL=0,STDT=RPTDT_.24
F S STDT=$O(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT),-1) Q:STDT=""!(STDT\1<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 REG=$P(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,0),U,3)
.. S COM=$O(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,20,0))
.. S DATE=STDT\1
.. S HDATE=$$FMTH^XLFDT(DATE,1)
.. I HDATE'>HP1B,HDATE'<HP1E S ARV(STAT,"P1",STDT,IEN)=REG_U_COM
.. I HDATE'>HP2B,HDATE'<HP2E S ARV(STAT,"P2",STDT,IEN)=REG_U_COM
.. I HDATE'>HP3B,HDATE'<HP3E S ARV(STAT,"P3",STDT,IEN)=REG_U_COM
;
; If patient stable all 3 periods, appropriate
S CT=0
F I="P1","P2","P3" I $D(ARV("S",I))>0 S CT=CT+1
; "HIVCHK","ARVAPPCNT"
I CT=3 S @TOTAPP=@TOTAPP+1 Q
;
; if unstable in any of the 3 periods and viral load is present w/i 8 weeks of change date
K BKLAB
S UNP=$O(ARV("U",""),-1)
I UNP'="" D
. S UNPDT=$O(ARV("U",UNP,""),-1)
. I UNPDT'="" D
.. S HN=""
.. F S HN=$O(ARV("U",UNP,UNPDT,HN)) Q:HN="" D
... I $P(ARV("U",UNP,UNPDT,HN),U,1)'="C" Q
... D LAB^BKMQQCRU(BKMDFN,UNPDT,.BKLAB)
I $D(BKLAB("ZLAB","VIRAL"))>0 S @TOTAPP=@TOTAPP+1 Q
;
; Unstable patient, discontinued
S UNP=$O(ARV("U",""),-1)
I UNP'="" D
. S UNPDT=$O(ARV("U",UNP,""),-1)
. I UNPDT'="" D Q:QFL
.. S HN=""
.. F S HN=$O(ARV("U",UNP,UNPDT,HN)) Q:HN="" D Q:QFL
... I $P(ARV("U",UNP,UNPDT,HN),U,1)'="D" Q
... S @TOTAPP=@TOTAPP+1,QFL=1
;
; Unstable patient, no change with comment
S UNP=$O(ARV("U",""),-1)
I UNP'="" D
. S UNPDT=$O(ARV("U",UNP,""),-1)
. I UNPDT'="" D Q:QFL
.. S HN=""
.. F S HN=$O(ARV("U",UNP,UNPDT,HN)) Q:HN="" D Q:QFL
... I $P(ARV("U",UNP,UNPDT,HN),U,1)'="N" Q
... I $P(ARV("U",UNP,UNPDT,HN),U,2)="" Q
... S @TOTAPP=@TOTAPP+1,QFL=1
Q
BKMQQCRV ;VNGT/HS/ALA-HIVQUAL ; 09 Aug 2010 2:16 PM
+1 ;;2.1;HIV MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
APP(BKMDFN,RPTDT) ;EP
+1 NEW QFL,STDT,IEN,RESULT,BKMIEN,BKMREG,REVPER,CT,STAT,REG,COM,DATE,HDATE,ARV,CT,I,BKLAB
+2 NEW UNP,UNPDT,HN,QFL
+3 DO DTR^BKMQQCRU(RPTDT)
+4 SET BKMIEN=$$BKMIEN^BKMIXX3(BKMDFN)
IF BKMIEN=""
QUIT 0
+5 SET BKMREG=$$BKMREG^BKMIXX3(BKMIEN)
+6 SET QFL=0
SET STDT=RPTDT_.24
+7 FOR
SET STDT=$ORDER(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT),-1)
IF STDT=""!(STDT\1<REVPER)
QUIT
Begin DoDot:1
+8 SET IEN=""
+9 FOR
SET IEN=$ORDER(^BKM(90451,BKMIEN,1,BKMREG,45,"B",STDT,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+10 SET STAT=$PIECE(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,0),U,2)
+11 SET REG=$PIECE(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,0),U,3)
+12 SET COM=$ORDER(^BKM(90451,BKMIEN,1,BKMREG,45,IEN,20,0))
+13 SET DATE=STDT\1
+14 SET HDATE=$$FMTH^XLFDT(DATE,1)
+15 IF HDATE'>HP1B
IF HDATE'<HP1E
SET ARV(STAT,"P1",STDT,IEN)=REG_U_COM
+16 IF HDATE'>HP2B
IF HDATE'<HP2E
SET ARV(STAT,"P2",STDT,IEN)=REG_U_COM
+17 IF HDATE'>HP3B
IF HDATE'<HP3E
SET ARV(STAT,"P3",STDT,IEN)=REG_U_COM
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+18 ;
+19 ; If patient stable all 3 periods, appropriate
+20 SET CT=0
+21 FOR I="P1","P2","P3"
IF $DATA(ARV("S",I))>0
SET CT=CT+1
+22 ; "HIVCHK","ARVAPPCNT"
+23 IF CT=3
SET @TOTAPP=@TOTAPP+1
QUIT
+24 ;
+25 ; if unstable in any of the 3 periods and viral load is present w/i 8 weeks of change date
+26 KILL BKLAB
+27 SET UNP=$ORDER(ARV("U",""),-1)
+28 IF UNP'=""
Begin DoDot:1
+29 SET UNPDT=$ORDER(ARV("U",UNP,""),-1)
+30 IF UNPDT'=""
Begin DoDot:2
+31 SET HN=""
+32 FOR
SET HN=$ORDER(ARV("U",UNP,UNPDT,HN))
IF HN=""
QUIT
Begin DoDot:3
+33 IF $PIECE(ARV("U",UNP,UNPDT,HN),U,1)'="C"
QUIT
+34 DO LAB^BKMQQCRU(BKMDFN,UNPDT,.BKLAB)
End DoDot:3
End DoDot:2
End DoDot:1
+35 IF $DATA(BKLAB("ZLAB","VIRAL"))>0
SET @TOTAPP=@TOTAPP+1
QUIT
+36 ;
+37 ; Unstable patient, discontinued
+38 SET UNP=$ORDER(ARV("U",""),-1)
+39 IF UNP'=""
Begin DoDot:1
+40 SET UNPDT=$ORDER(ARV("U",UNP,""),-1)
+41 IF UNPDT'=""
Begin DoDot:2
+42 SET HN=""
+43 FOR
SET HN=$ORDER(ARV("U",UNP,UNPDT,HN))
IF HN=""
QUIT
Begin DoDot:3
+44 IF $PIECE(ARV("U",UNP,UNPDT,HN),U,1)'="D"
QUIT
+45 SET @TOTAPP=@TOTAPP+1
SET QFL=1
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
+46 ;
+47 ; Unstable patient, no change with comment
+48 SET UNP=$ORDER(ARV("U",""),-1)
+49 IF UNP'=""
Begin DoDot:1
+50 SET UNPDT=$ORDER(ARV("U",UNP,""),-1)
+51 IF UNPDT'=""
Begin DoDot:2
+52 SET HN=""
+53 FOR
SET HN=$ORDER(ARV("U",UNP,UNPDT,HN))
IF HN=""
QUIT
Begin DoDot:3
+54 IF $PIECE(ARV("U",UNP,UNPDT,HN),U,1)'="N"
QUIT
+55 IF $PIECE(ARV("U",UNP,UNPDT,HN),U,2)=""
QUIT
+56 SET @TOTAPP=@TOTAPP+1
SET QFL=1
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
+57 QUIT
