- 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
