BQITRPPT ;PRXM/HC/ALA-Treatment Prompt ; 24 Apr 2007 11:47 AM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
FND(BQTRMT,BQGLOB,BQDFN,BQRM) ;EP
;
; Input Parameters
; BQTRMT - Treatment Prompt
; BQGLOB - Reference to store data
; BQDFN - Patient IEN
; BQRM - Remarks array
; Output Parameter
; MEET - If zero, didn't meet the criteria
; If one, did meet the criteria
;
NEW BQREF,CEXE,MEET,N,TAX,NIT,TMFRAME,FREF,ABS,CONT,GREF,TREF,IEN,TIEN,EXEC
NEW CEXEC,BQIAND,BQIOR
;S BQREF="BQIRY" K @BQREF
;D BLD(BQTRMT,BQREF,.CEXEC)
;
; Find if there is a special executable for the treatment prompt
S EXEC=$G(^BQI(90508.5,BQTRMT,2))
I $G(EXEC)'="" X EXEC
; EXEC should always return RESULT
;
; update remarks if patient passed all the checks
I $P(RESULT,U,1)=1 D
. K PARMS
. ; Set the parameter values returned from API
. F BN=3:1:$L(RESULT,U) S PARMS(BN-2)=$P(RESULT,U,BN)
. S BN=0
. F S BN=$O(BQRM(BN)) Q:BN="" D
.. I BQRM(BN)'["|" Q
.. ; Apply parameters into remarks
.. S NDESC=BQRM(BN)
.. F Q:'$F(NDESC,"|") D PRS
.. S BQRM(BN)=PDESC
Q RESULT
;
S MEET=1
;
; If taxonomy checks are used to determine whether patient meets criteria or not
I $D(@BQREF) D
. S N=0 F S N=$O(@BQREF@(N)) Q:'N D
.. S TAX=$P(@BQREF@(N),U,1),NIT=$P(@BQREF@(N),U,2)
.. S TMFRAME=$P(@BQREF@(N),U,3),FREF=$P(@BQREF@(N),U,4)
.. I TMFRAME'="" S EDATE=$$DATE^BQIUL1(TMFRAME),BDATE=DT
.. I TMFRAME="" S EDATE=$$DATE^BQIUL1("T-12M"),BDATE=DT
.. S ABS=$P(@BQREF@(N),U,5),CONT=+$P(@BQREF@(N),U,6)
.. ;
.. ; Check for a contraindication executable
.. S CEXE=$G(CEXEC(N))
.. I $G(CEXE)'="" D Q
... S DFN=BQDFN
... ;I $G(DFN)="" S DFN=BQDFN
... X CEXE
... ;
... ; If absence/presence is defined
... I ABS'="" D
.... I 'X,'ABS S MEET=1 Q
.... I 'X,ABS S MEET=0 Q
.... I X,'ABS S MEET=0 Q
.... I X,ABS S MEET=1
... ; If absence/presence is not defined
... I ABS="" D
.... I X S MEET=1 Q
.... I 'X S MEET=0
... ;I MEET,X,CONT S MEET=0
... ;I MEET,X,'CONT S MEET=1
... ;I MEET,'X,'CONT S MEET=0
... ; If met criteria but also met contraindication
... I MEET,CONT S MEET=0
... I MEET,'CONT S MEET=1
... I 'MEET,CONT S MEET=1
... I 'MEET,'CONT S MEET=0
... ;
... Q:'MEET
... ; update remarks if patient passed all the checks
... K PARMS
... F BN=2:1:$L(X,U) S PARMS(BN-1)=$P(X,U,BN)
... S BN=0
... F S BN=$O(BQRM(BN)) Q:BN="" D
.... I BQRM(BN)'["|" Q
.... S NDESC=BQRM(BN)
.... F Q:'$F(NDESC,"|") D PRS
.... ;I PDESC["~"
.... S BQRM(BN)=PDESC
.. ;
.. S GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
.. ; Build the taxonomy reference
.. K @TREF
.. Q:TAX=""
.. D BLD^BQITUTL(TAX,TREF)
.. S IEN="",QFL=0
.. F S IEN=$O(@GREF@("AC",BQDFN,IEN),-1) Q:IEN="" D Q:QFL
... S TIEN=$$GET1^DIQ(FREF,IEN_",",.01,"I") I TIEN="" Q
... I '$D(@TREF@(TIEN)) Q
... S VISIT=$$GET1^DIQ(FREF,IEN_",",.03,"I") I VISIT="" Q
... I $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1 Q
... S VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 I VSDTM=0 Q
... I $G(TMFRAME)'="",VSDTM<EDATE Q
... ; If absence of data, then it did not meet the criteria
... I ABS=0 S MEET=0,QFL=1 Q
... S MEET=1_U_VSDTM_U_U_VISIT_U_IEN,QFL=1
.. I $G(BQIAND)'="" D
... I BQIAND,MEET Q
... I 'BQIAND,MEET S MEET=0
;
I $G(EXEC)'="" X EXEC
;
XIT Q MEET
;
BLD(TRMT,REF,CEXEC) ;EP
K CEXEC
NEW BN,IEN,DATA
S BN=0
F S BN=$O(^BQI(90508.5,TRMT,5,"B",BN)) Q:'BN D
. S IEN=0
. F S IEN=$O(^BQI(90508.5,TRMT,5,"B",BN,IEN)) Q:'IEN D
.. S DATA=^BQI(90508.5,TRMT,5,IEN,0)
.. ; Exclude the SEARCH ORDER field and only take pieces 2-7
.. S @REF@(BN)=$P(DATA,U,2,7)
.. S CEXEC(BN)=$G(^BQI(90508.5,TRMT,5,IEN,1))
Q
;
PRS ; Parse description
S NDESC=$P(NDESC,"|",1)_$G(PARMS($P(NDESC,"|",2)))_$P(NDESC,"|",3,99)
S PDESC=NDESC
Q
BQITRPPT ;PRXM/HC/ALA-Treatment Prompt ; 24 Apr 2007 11:47 AM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
FND(BQTRMT,BQGLOB,BQDFN,BQRM) ;EP
+1 ;
+2 ; Input Parameters
+3 ; BQTRMT - Treatment Prompt
+4 ; BQGLOB - Reference to store data
+5 ; BQDFN - Patient IEN
+6 ; BQRM - Remarks array
+7 ; Output Parameter
+8 ; MEET - If zero, didn't meet the criteria
+9 ; If one, did meet the criteria
+10 ;
+11 NEW BQREF,CEXE,MEET,N,TAX,NIT,TMFRAME,FREF,ABS,CONT,GREF,TREF,IEN,TIEN,EXEC
+12 NEW CEXEC,BQIAND,BQIOR
+13 ;S BQREF="BQIRY" K @BQREF
+14 ;D BLD(BQTRMT,BQREF,.CEXEC)
+15 ;
+16 ; Find if there is a special executable for the treatment prompt
+17 SET EXEC=$GET(^BQI(90508.5,BQTRMT,2))
+18 IF $GET(EXEC)'=""
XECUTE EXEC
+19 ; EXEC should always return RESULT
+20 ;
+21 ; update remarks if patient passed all the checks
+22 IF $PIECE(RESULT,U,1)=1
Begin DoDot:1
+23 KILL PARMS
+24 ; Set the parameter values returned from API
+25 FOR BN=3:1:$LENGTH(RESULT,U)
SET PARMS(BN-2)=$PIECE(RESULT,U,BN)
+26 SET BN=0
+27 FOR
SET BN=$ORDER(BQRM(BN))
IF BN=""
QUIT
Begin DoDot:2
+28 IF BQRM(BN)'["|"
QUIT
+29 ; Apply parameters into remarks
+30 SET NDESC=BQRM(BN)
+31 FOR
IF '$FIND(NDESC,"|")
QUIT
DO PRS
+32 SET BQRM(BN)=PDESC
End DoDot:2
End DoDot:1
+33 QUIT RESULT
+34 ;
+35 SET MEET=1
+36 ;
+37 ; If taxonomy checks are used to determine whether patient meets criteria or not
+38 IF $DATA(@BQREF)
Begin DoDot:1
+39 SET N=0
FOR
SET N=$ORDER(@BQREF@(N))
IF 'N
QUIT
Begin DoDot:2
+40 SET TAX=$PIECE(@BQREF@(N),U,1)
SET NIT=$PIECE(@BQREF@(N),U,2)
+41 SET TMFRAME=$PIECE(@BQREF@(N),U,3)
SET FREF=$PIECE(@BQREF@(N),U,4)
+42 IF TMFRAME'=""
SET EDATE=$$DATE^BQIUL1(TMFRAME)
SET BDATE=DT
+43 IF TMFRAME=""
SET EDATE=$$DATE^BQIUL1("T-12M")
SET BDATE=DT
+44 SET ABS=$PIECE(@BQREF@(N),U,5)
SET CONT=+$PIECE(@BQREF@(N),U,6)
+45 ;
+46 ; Check for a contraindication executable
+47 SET CEXE=$GET(CEXEC(N))
+48 IF $GET(CEXE)'=""
Begin DoDot:3
+49 SET DFN=BQDFN
+50 ;I $G(DFN)="" S DFN=BQDFN
+51 XECUTE CEXE
+52 ;
+53 ; If absence/presence is defined
+54 IF ABS'=""
Begin DoDot:4
+55 IF 'X
IF 'ABS
SET MEET=1
QUIT
+56 IF 'X
IF ABS
SET MEET=0
QUIT
+57 IF X
IF 'ABS
SET MEET=0
QUIT
+58 IF X
IF ABS
SET MEET=1
End DoDot:4
+59 ; If absence/presence is not defined
+60 IF ABS=""
Begin DoDot:4
+61 IF X
SET MEET=1
QUIT
+62 IF 'X
SET MEET=0
End DoDot:4
+63 ;I MEET,X,CONT S MEET=0
+64 ;I MEET,X,'CONT S MEET=1
+65 ;I MEET,'X,'CONT S MEET=0
+66 ; If met criteria but also met contraindication
+67 IF MEET
IF CONT
SET MEET=0
+68 IF MEET
IF 'CONT
SET MEET=1
+69 IF 'MEET
IF CONT
SET MEET=1
+70 IF 'MEET
IF 'CONT
SET MEET=0
+71 ;
+72 IF 'MEET
QUIT
+73 ; update remarks if patient passed all the checks
+74 KILL PARMS
+75 FOR BN=2:1:$LENGTH(X,U)
SET PARMS(BN-1)=$PIECE(X,U,BN)
+76 SET BN=0
+77 FOR
SET BN=$ORDER(BQRM(BN))
IF BN=""
QUIT
Begin DoDot:4
+78 IF BQRM(BN)'["|"
QUIT
+79 SET NDESC=BQRM(BN)
+80 FOR
IF '$FIND(NDESC,"|")
QUIT
DO PRS
+81 ;I PDESC["~"
+82 SET BQRM(BN)=PDESC
End DoDot:4
End DoDot:3
QUIT
+83 ;
+84 SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
+85 ; Build the taxonomy reference
+86 KILL @TREF
+87 IF TAX=""
QUIT
+88 DO BLD^BQITUTL(TAX,TREF)
+89 SET IEN=""
SET QFL=0
+90 FOR
SET IEN=$ORDER(@GREF@("AC",BQDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+91 SET TIEN=$$GET1^DIQ(FREF,IEN_",",.01,"I")
IF TIEN=""
QUIT
+92 IF '$DATA(@TREF@(TIEN))
QUIT
+93 SET VISIT=$$GET1^DIQ(FREF,IEN_",",.03,"I")
IF VISIT=""
QUIT
+94 IF $$GET1^DIQ(9000010,VISIT_",",.11,"I")=1
QUIT
+95 SET VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1
IF VSDTM=0
QUIT
+96 IF $GET(TMFRAME)'=""
IF VSDTM<EDATE
QUIT
+97 ; If absence of data, then it did not meet the criteria
+98 IF ABS=0
SET MEET=0
SET QFL=1
QUIT
+99 SET MEET=1_U_VSDTM_U_U_VISIT_U_IEN
SET QFL=1
End DoDot:3
IF QFL
QUIT
+100 IF $GET(BQIAND)'=""
Begin DoDot:3
+101 IF BQIAND
IF MEET
QUIT
+102 IF 'BQIAND
IF MEET
SET MEET=0
End DoDot:3
End DoDot:2
End DoDot:1
+103 ;
+104 IF $GET(EXEC)'=""
XECUTE EXEC
+105 ;
XIT QUIT MEET
+1 ;
BLD(TRMT,REF,CEXEC) ;EP
+1 KILL CEXEC
+2 NEW BN,IEN,DATA
+3 SET BN=0
+4 FOR
SET BN=$ORDER(^BQI(90508.5,TRMT,5,"B",BN))
IF 'BN
QUIT
Begin DoDot:1
+5 SET IEN=0
+6 FOR
SET IEN=$ORDER(^BQI(90508.5,TRMT,5,"B",BN,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+7 SET DATA=^BQI(90508.5,TRMT,5,IEN,0)
+8 ; Exclude the SEARCH ORDER field and only take pieces 2-7
+9 SET @REF@(BN)=$PIECE(DATA,U,2,7)
+10 SET CEXEC(BN)=$GET(^BQI(90508.5,TRMT,5,IEN,1))
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
PRS ; Parse description
+1 SET NDESC=$PIECE(NDESC,"|",1)_$GET(PARMS($PIECE(NDESC,"|",2)))_$PIECE(NDESC,"|",3,99)
+2 SET PDESC=NDESC
+3 QUIT
