- 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
