BQIRGUT1 ;GDHD/HS/ALA-Register Utility ; 27 Apr 2016 7:40 AM
;;2.5;ICARE MANAGEMENT SYSTEM;**1,2**;May 24, 2016;Build 14
;
;
ITM(TMFRAME,BQDFN,FREF,RREF,TIEN,TAX,TREF) ;EP - Find the value
; Find visits for a request item
; Input
; TMFRAME - Time frame to search data for
; BQDFN - Patient internal entry number
; FREF - File to search in
; RREF - Search file table file
; TIEN - Item to search on
; TAX - Taxonomy
; TREF - Reference array
;
NEW GREF,ENDT,IEN,QFL,RESULT,VISIT,VSDTM,RES,DTM,ITIEN,EDT,BDT,VFL
NEW SRCTYP,BQRES
S TMFRAME=$G(TMFRAME,"")
;I $G(TREF)'="" B
I $G(TAX)'="" D
. S TREF=$NA(^TMP($J,"BQITAX")) K @TREF
. I $G(RREF)=60 D BLD^BQITUTL(TAX,TREF,"L") Q
. D BLD^BQITUTL(TAX,TREF)
I $G(TAX)="" D
. I $G(TIEN)="" Q
. S TREF="BQITAX" K @TREF
. S @TREF@(TIEN)=""
S GREF=$$ROOT^DILFD(FREF,"",1)
S VFL=$O(^BQI(90508.6,"B",FREF,""))
I VFL'="" S SRCTYP=$P(^BQI(90508.6,VFL,0),U,3)
S ENDT=$$DATE^BQIUL1(TMFRAME)
S IEN="",QFL=0,RESULT=0
I $G(TMFRAME)'="" D
. S EDT=9999999-ENDT,BDT=""
. I SRCTYP'=2 D Q
.. F S BDT=$O(@GREF@("AA",BQDFN,BDT)) Q:BDT=""!(BDT>EDT) D Q:QFL
... S IEN=""
... F S IEN=$O(@GREF@("AA",BQDFN,BDT,IEN)) Q:IEN="" D Q:QFL
.... S ITIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I ITIEN="" Q
.... S RES=$$GET1^DIQ(FREF,IEN,.04,"I")
.... I $G(TIEN)'="",ITIEN'=TIEN Q
.... I $G(TIEN)="",'$D(@TREF@(ITIEN)) Q
.... S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
.... I $P($G(^AUPNVSIT(VISIT,0)),"^",11)=1 Q
.... S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),"^",1)\1 I VSDTM=0 Q
.... S BQRES(VSDTM,VISIT,IEN)=RES
. ;
. F S BDT=$O(@GREF@("AA",PTDFN,TIEN,BDT)) Q:BDT=""!(BDT>EDT) D
.. S IEN=""
.. F S IEN=$O(@GREF@("AA",PTDFN,TIEN,BDT,IEN)) Q:IEN="" D
... S ITIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I ITIEN="" Q
... S RES=$$GET1^DIQ(FREF,IEN,.04,"I")
... I $G(TIEN)'="",ITIEN'=TIEN Q
... I $G(TIEN)="",'$D(@TREF@(ITIEN)) Q
... S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
... I $P($G(^AUPNVSIT(VISIT,0)),"^",11)=1 Q
... S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),"^",1)\1 I VSDTM=0 Q
... S BQRES(VSDTM,VISIT,IEN)=RES
. ; check for refusal
. I $O(^AUPNPREF("AA",BQDFN,RREF,""))'="" D
.. I $D(TREF) S TIEN="" F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
... S EDT=9999999-ENDT,BDT=""
... F S BDT=$O(^AUPNPREF("AA",BQDFN,RREF,TIEN,BDT)) Q:BDT=""!(BDT>EDT) D
.... S IEN="" F S IEN=$O(^AUPNPREF("AA",BQDFN,RREF,TIEN,BDT,IEN)) Q:IEN="" D
..... S DTM=$P(^AUPNPREF(IEN,0),U,3)
..... I $P(RESULT,U,2)'="",DTM<$P(RESULT,U,2) Q
..... S BQRES(DTM,"~","~")="refusal"
;
I $G(TMFRAME)="" D
. S IEN=""
. F S IEN=$O(@GREF@("AC",BQDFN,IEN),-1) Q:IEN="" D Q:QFL
.. S ITIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I ITIEN="" Q
.. I $G(TIEN)'="",ITIEN'=TIEN Q
.. I $G(TIEN)="",'$D(@TREF@(ITIEN)) Q
.. S RES=$$GET1^DIQ(FREF,IEN,.04,"I")
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
.. I $P($G(^AUPNVSIT(VISIT,0)),"^",11)=1 Q
.. S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),"^",1)\1 I VSDTM=0 Q
.. S BQRES(VSDTM,VISIT,IEN)=RES
. ; check for refusal
. I $O(^AUPNPREF("AA",BQDFN,RREF,""))'="" D
.. I $D(TREF) S TIEN="" F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
... ;S EDT=(9999999-DT)+.001,BDT=""
... S BDT="",STOP=0
... F S BDT=$O(^AUPNPREF("AA",BQDFN,RREF,TIEN,BDT)) Q:BDT="" D Q:STOP
.... S IEN="" F S IEN=$O(^AUPNPREF("AA",BQDFN,RREF,TIEN,BDT,IEN)) Q:IEN="" D Q:STOP
..... S DTM=$P(^AUPNPREF(IEN,0),U,3)
..... I $P(RESULT,U,2)'="",DTM<$P(RESULT,U,2) Q
..... S BQRES(DTM,"~","~")="refusal"
;
I '$D(BQRES) S RESULT=0
I $D(BQRES) D
. S DTM=$O(BQRES(""),-1),VISIT=$O(BQRES(DTM,""),-1),IEN=$O(BQRES(DTM,VISIT,""),-1)
. S RES=BQRES(DTM,VISIT,IEN)
. S RESULT=1_U_DTM_U_U_VISIT_U_IEN_U_RES
Q RESULT
BQIRGUT1 ;GDHD/HS/ALA-Register Utility ; 27 Apr 2016 7:40 AM
+1 ;;2.5;ICARE MANAGEMENT SYSTEM;**1,2**;May 24, 2016;Build 14
+2 ;
+3 ;
ITM(TMFRAME,BQDFN,FREF,RREF,TIEN,TAX,TREF) ;EP - Find the value
+1 ; Find visits for a request item
+2 ; Input
+3 ; TMFRAME - Time frame to search data for
+4 ; BQDFN - Patient internal entry number
+5 ; FREF - File to search in
+6 ; RREF - Search file table file
+7 ; TIEN - Item to search on
+8 ; TAX - Taxonomy
+9 ; TREF - Reference array
+10 ;
+11 NEW GREF,ENDT,IEN,QFL,RESULT,VISIT,VSDTM,RES,DTM,ITIEN,EDT,BDT,VFL
+12 NEW SRCTYP,BQRES
+13 SET TMFRAME=$GET(TMFRAME,"")
+14 ;I $G(TREF)'="" B
+15 IF $GET(TAX)'=""
Begin DoDot:1
+16 SET TREF=$NAME(^TMP($JOB,"BQITAX"))
KILL @TREF
+17 IF $GET(RREF)=60
DO BLD^BQITUTL(TAX,TREF,"L")
QUIT
+18 DO BLD^BQITUTL(TAX,TREF)
End DoDot:1
+19 IF $GET(TAX)=""
Begin DoDot:1
+20 IF $GET(TIEN)=""
QUIT
+21 SET TREF="BQITAX"
KILL @TREF
+22 SET @TREF@(TIEN)=""
End DoDot:1
+23 SET GREF=$$ROOT^DILFD(FREF,"",1)
+24 SET VFL=$ORDER(^BQI(90508.6,"B",FREF,""))
+25 IF VFL'=""
SET SRCTYP=$PIECE(^BQI(90508.6,VFL,0),U,3)
+26 SET ENDT=$$DATE^BQIUL1(TMFRAME)
+27 SET IEN=""
SET QFL=0
SET RESULT=0
+28 IF $GET(TMFRAME)'=""
Begin DoDot:1
+29 SET EDT=9999999-ENDT
SET BDT=""
+30 IF SRCTYP'=2
Begin DoDot:2
+31 FOR
SET BDT=$ORDER(@GREF@("AA",BQDFN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:3
+32 SET IEN=""
+33 FOR
SET IEN=$ORDER(@GREF@("AA",BQDFN,BDT,IEN))
IF IEN=""
QUIT
Begin DoDot:4
+34 SET ITIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF ITIEN=""
QUIT
+35 SET RES=$$GET1^DIQ(FREF,IEN,.04,"I")
+36 IF $GET(TIEN)'=""
IF ITIEN'=TIEN
QUIT
+37 IF $GET(TIEN)=""
IF '$DATA(@TREF@(ITIEN))
QUIT
+38 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+39 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),"^",11)=1
QUIT
+40 SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",1)\1
IF VSDTM=0
QUIT
+41 SET BQRES(VSDTM,VISIT,IEN)=RES
End DoDot:4
IF QFL
QUIT
End DoDot:3
IF QFL
QUIT
End DoDot:2
QUIT
+42 ;
+43 FOR
SET BDT=$ORDER(@GREF@("AA",PTDFN,TIEN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:2
+44 SET IEN=""
+45 FOR
SET IEN=$ORDER(@GREF@("AA",PTDFN,TIEN,BDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+46 SET ITIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF ITIEN=""
QUIT
+47 SET RES=$$GET1^DIQ(FREF,IEN,.04,"I")
+48 IF $GET(TIEN)'=""
IF ITIEN'=TIEN
QUIT
+49 IF $GET(TIEN)=""
IF '$DATA(@TREF@(ITIEN))
QUIT
+50 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+51 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),"^",11)=1
QUIT
+52 SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",1)\1
IF VSDTM=0
QUIT
+53 SET BQRES(VSDTM,VISIT,IEN)=RES
End DoDot:3
End DoDot:2
+54 ; check for refusal
+55 IF $ORDER(^AUPNPREF("AA",BQDFN,RREF,""))'=""
Begin DoDot:2
+56 IF $DATA(TREF)
SET TIEN=""
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:3
+57 SET EDT=9999999-ENDT
SET BDT=""
+58 FOR
SET BDT=$ORDER(^AUPNPREF("AA",BQDFN,RREF,TIEN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:4
+59 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNPREF("AA",BQDFN,RREF,TIEN,BDT,IEN))
IF IEN=""
QUIT
Begin DoDot:5
+60 SET DTM=$PIECE(^AUPNPREF(IEN,0),U,3)
+61 IF $PIECE(RESULT,U,2)'=""
IF DTM<$PIECE(RESULT,U,2)
QUIT
+62 SET BQRES(DTM,"~","~")="refusal"
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+63 ;
+64 IF $GET(TMFRAME)=""
Begin DoDot:1
+65 SET IEN=""
+66 FOR
SET IEN=$ORDER(@GREF@("AC",BQDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+67 SET ITIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF ITIEN=""
QUIT
+68 IF $GET(TIEN)'=""
IF ITIEN'=TIEN
QUIT
+69 IF $GET(TIEN)=""
IF '$DATA(@TREF@(ITIEN))
QUIT
+70 SET RES=$$GET1^DIQ(FREF,IEN,.04,"I")
+71 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+72 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),"^",11)=1
QUIT
+73 SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",1)\1
IF VSDTM=0
QUIT
+74 SET BQRES(VSDTM,VISIT,IEN)=RES
End DoDot:2
IF QFL
QUIT
+75 ; check for refusal
+76 IF $ORDER(^AUPNPREF("AA",BQDFN,RREF,""))'=""
Begin DoDot:2
+77 IF $DATA(TREF)
SET TIEN=""
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:3
+78 ;S EDT=(9999999-DT)+.001,BDT=""
+79 SET BDT=""
SET STOP=0
+80 FOR
SET BDT=$ORDER(^AUPNPREF("AA",BQDFN,RREF,TIEN,BDT))
IF BDT=""
QUIT
Begin DoDot:4
+81 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNPREF("AA",BQDFN,RREF,TIEN,BDT,IEN))
IF IEN=""
QUIT
Begin DoDot:5
+82 SET DTM=$PIECE(^AUPNPREF(IEN,0),U,3)
+83 IF $PIECE(RESULT,U,2)'=""
IF DTM<$PIECE(RESULT,U,2)
QUIT
+84 SET BQRES(DTM,"~","~")="refusal"
End DoDot:5
IF STOP
QUIT
End DoDot:4
IF STOP
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+85 ;
+86 IF '$DATA(BQRES)
SET RESULT=0
+87 IF $DATA(BQRES)
Begin DoDot:1
+88 SET DTM=$ORDER(BQRES(""),-1)
SET VISIT=$ORDER(BQRES(DTM,""),-1)
SET IEN=$ORDER(BQRES(DTM,VISIT,""),-1)
+89 SET RES=BQRES(DTM,VISIT,IEN)
+90 SET RESULT=1_U_DTM_U_U_VISIT_U_IEN_U_RES
End DoDot:1
+91 QUIT RESULT
