BQIDCTX ;VNGT/HS/ALA-Taxonomy Search ; 01 Feb 2007 6:29 PM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
Q
;
TAX(DATA,PARMS,MPARMS) ;EP
;
;Description
; Executable to retrieve those patients which have data in RPMS for
; specified taxonomies
;Input
; PARMS = Array of parameters and their values
; MPARMS = Multiple array of a parameter
;Expected to return DATA
;
NEW UID,II,X,TGLOB,NM,FROM,THRU,VISITS,TAX,DFN
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J),II=0
S DATA=$NA(^TMP("BQIDCTX",UID)),TGLOB=$NA(^TMP("BQIDCTG",UID))
K @DATA,@TGLOB
;
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIDCTX D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
I '$D(PARMS),'$D(MPARMS) Q
;
S NM=""
F S NM=$O(PARMS(NM)) Q:NM="" D
. S @NM=$P(PARMS(NM),U,1)
. F I=2:1:$L(PARMS(NM),U) Q:$P(PARMS(NM),U,I)="" S @($P(PARMS(NM),U,I))
;
; If a single taxonomy
I $G(TAX)'="" D TAX1 M @DATA=@TGLOB G DONE
;
; If multiple taxonomies
I $D(MPARMS("TAX")) S TAX="" F S TAX=$O(MPARMS("TAX",TAX)) Q:TAX="" D
. F I=1:1:$L(MPARMS("TAX",TAX),U) Q:$P(MPARMS("TAX",TAX),U,I)="" S @($P(MPARMS("TAX",TAX),U,I))
. D TAX1
. S DFN=""
. F S DFN=$O(@TGLOB@(DFN)) Q:DFN="" I @TGLOB@(DFN)<VISITS K @TGLOB@(DFN)
. M @DATA=@TGLOB
;
DONE ;
K @TREF,@TGLOB,FROM,THRU,VISITS
Q
;
TAX1 ;
; Parameters
; QN = QMan link IEN
; FREF = Target FileMan File Reference
; FLD = Target Field Number
; GREF = Global reference
; TREF = Taxonomy reference
NEW GREF,TREF,QN,TAXNM,FREF,FLD,TN,XRF,IEN,VISIT,VSDTM
S TAXNM=$P($G(^ATXAX(TAX,0)),U,1)
S QN=$P($G(^ATXAX(TAX,0)),U,12) I QN="" Q
S FREF=$P($G(^AMQQ(1,QN,0)),U,3) I FREF="" Q
S FLD=$P($G(^AMQQ(1,QN,0)),U,4)
S GREF=$$ROOT^DILFD(FREF,"",1)
S TREF=$NA(^TMP("BQITAX",UID))
K @TREF
; Build the values to look for from the taxonomy in temporary global
D BLD^BQITUTL(TAXNM,TREF)
;
S TN="" F S TN=$O(@TREF@(TN)) Q:TN="" D FND
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
FND ;
I FLD=".01" S XRF="B" ; Could be "AF" in the future
S IEN=""
F S IEN=$O(@GREF@(XRF,TN,IEN),-1) Q:IEN="" D
. S DFN=$P($G(@GREF@(IEN,0)),U,2) I DFN="" Q
. ; User may now select Living, Deceased or both as a filter so
. ; if no filters defined assume living patients otherwise let filter decide
. ;I $O(^BQICARE(OWNR,1,PLIEN,15,0))="",$P($G(^DPT(DFN,.35)),U,1)'="" Q
. ; If patient has no active HRNs, quit
. I '$$HRN^BQIUL1(DFN) Q
. ; If patient has no visit in last 3 years, quit
. ;I '$$VTHR^BQIUL1(DFN) Q
. ;
. S VISIT=$P($G(@GREF@(IEN,0)),U,3) I VISIT="" Q
. ; If visit has been deleted, quit
. I $P(^AUPNVSIT(VISIT,0),U,11)=1 Q
. S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),U,1)\1 I VSDTM=0 Q
. I $G(FROM)'="",$G(THRU)'="" S QFL=0 D Q:QFL
.. I VSDTM<FROM!(VSDTM>THRU) S QFL=1
. I $G(VISITS)="" S @TGLOB@(DFN)="" Q
. I $G(VISITS)'="" Q:$G(@TGLOB@(DFN))'<VISITS S @TGLOB@(DFN)=$G(@TGLOB@(DFN))+1
Q
BQIDCTX ;VNGT/HS/ALA-Taxonomy Search ; 01 Feb 2007 6:29 PM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
+3 QUIT
+4 ;
TAX(DATA,PARMS,MPARMS) ;EP
+1 ;
+2 ;Description
+3 ; Executable to retrieve those patients which have data in RPMS for
+4 ; specified taxonomies
+5 ;Input
+6 ; PARMS = Array of parameters and their values
+7 ; MPARMS = Multiple array of a parameter
+8 ;Expected to return DATA
+9 ;
+10 NEW UID,II,X,TGLOB,NM,FROM,THRU,VISITS,TAX,DFN
+11 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
SET II=0
+12 SET DATA=$NAME(^TMP("BQIDCTX",UID))
SET TGLOB=$NAME(^TMP("BQIDCTG",UID))
+13 KILL @DATA,@TGLOB
+14 ;
+15 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIDCTX D UNWIND^%ZTER"
+16 ;
+17 IF '$DATA(PARMS)
IF '$DATA(MPARMS)
QUIT
+18 ;
+19 SET NM=""
+20 FOR
SET NM=$ORDER(PARMS(NM))
IF NM=""
QUIT
Begin DoDot:1
+21 SET @NM=$PIECE(PARMS(NM),U,1)
+22 FOR I=2:1:$LENGTH(PARMS(NM),U)
IF $PIECE(PARMS(NM),U,I)=""
QUIT
SET @($PIECE(PARMS(NM),U,I))
End DoDot:1
+23 ;
+24 ; If a single taxonomy
+25 IF $GET(TAX)'=""
DO TAX1
MERGE @DATA=@TGLOB
GOTO DONE
+26 ;
+27 ; If multiple taxonomies
+28 IF $DATA(MPARMS("TAX"))
SET TAX=""
FOR
SET TAX=$ORDER(MPARMS("TAX",TAX))
IF TAX=""
QUIT
Begin DoDot:1
+29 FOR I=1:1:$LENGTH(MPARMS("TAX",TAX),U)
IF $PIECE(MPARMS("TAX",TAX),U,I)=""
QUIT
SET @($PIECE(MPARMS("TAX",TAX),U,I))
+30 DO TAX1
+31 SET DFN=""
+32 FOR
SET DFN=$ORDER(@TGLOB@(DFN))
IF DFN=""
QUIT
IF @TGLOB@(DFN)<VISITS
KILL @TGLOB@(DFN)
+33 MERGE @DATA=@TGLOB
End DoDot:1
+34 ;
DONE ;
+1 KILL @TREF,@TGLOB,FROM,THRU,VISITS
+2 QUIT
+3 ;
TAX1 ;
+1 ; Parameters
+2 ; QN = QMan link IEN
+3 ; FREF = Target FileMan File Reference
+4 ; FLD = Target Field Number
+5 ; GREF = Global reference
+6 ; TREF = Taxonomy reference
+7 NEW GREF,TREF,QN,TAXNM,FREF,FLD,TN,XRF,IEN,VISIT,VSDTM
+8 SET TAXNM=$PIECE($GET(^ATXAX(TAX,0)),U,1)
+9 SET QN=$PIECE($GET(^ATXAX(TAX,0)),U,12)
IF QN=""
QUIT
+10 SET FREF=$PIECE($GET(^AMQQ(1,QN,0)),U,3)
IF FREF=""
QUIT
+11 SET FLD=$PIECE($GET(^AMQQ(1,QN,0)),U,4)
+12 SET GREF=$$ROOT^DILFD(FREF,"",1)
+13 SET TREF=$NAME(^TMP("BQITAX",UID))
+14 KILL @TREF
+15 ; Build the values to look for from the taxonomy in temporary global
+16 DO BLD^BQITUTL(TAXNM,TREF)
+17 ;
+18 SET TN=""
FOR
SET TN=$ORDER(@TREF@(TN))
IF TN=""
QUIT
DO FND
+19 QUIT
+20 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
FND ;
+1 ; Could be "AF" in the future
IF FLD=".01"
SET XRF="B"
+2 SET IEN=""
+3 FOR
SET IEN=$ORDER(@GREF@(XRF,TN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+4 SET DFN=$PIECE($GET(@GREF@(IEN,0)),U,2)
IF DFN=""
QUIT
+5 ; User may now select Living, Deceased or both as a filter so
+6 ; if no filters defined assume living patients otherwise let filter decide
+7 ;I $O(^BQICARE(OWNR,1,PLIEN,15,0))="",$P($G(^DPT(DFN,.35)),U,1)'="" Q
+8 ; If patient has no active HRNs, quit
+9 IF '$$HRN^BQIUL1(DFN)
QUIT
+10 ; If patient has no visit in last 3 years, quit
+11 ;I '$$VTHR^BQIUL1(DFN) Q
+12 ;
+13 SET VISIT=$PIECE($GET(@GREF@(IEN,0)),U,3)
IF VISIT=""
QUIT
+14 ; If visit has been deleted, quit
+15 IF $PIECE(^AUPNVSIT(VISIT,0),U,11)=1
QUIT
+16 SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,1)\1
IF VSDTM=0
QUIT
+17 IF $GET(FROM)'=""
IF $GET(THRU)'=""
SET QFL=0
Begin DoDot:2
+18 IF VSDTM<FROM!(VSDTM>THRU)
SET QFL=1
End DoDot:2
IF QFL
QUIT
+19 IF $GET(VISITS)=""
SET @TGLOB@(DFN)=""
QUIT
+20 IF $GET(VISITS)'=""
IF $GET(@TGLOB@(DFN))'<VISITS
QUIT
SET @TGLOB@(DFN)=$GET(@TGLOB@(DFN))+1
End DoDot:1
+21 QUIT
