BQIUTIL ;VNGT/HS/ALA-Utility Program ; 10 Nov 2008 9:53 AM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
MREC(PTDFN,FREF,ITEM) ;EP
; Find the most recent value for a specified item
; Input
; PTDFN - Patient IEN
; FREF - FileMan file number
; ITEM - Item (.01 external value)
;
NEW RESULT,GREF,ENDT,IEN,TIEN,TEMP,QFL,XREF,IGREF,RITEM,BQPAR
S RESULT=0
;
S ITEM=$G(ITEM,"")
I ITEM="" Q RESULT
D FIELD^DID(FREF,.01,"","POINTER","BQPAR")
S IGREF=$G(BQPAR("POINTER")),XREF="""B""" I IGREF="" Q RESULT
S IGREF=U_IGREF_XREF_")"
S RITEM=$O(@IGREF@(ITEM,"")) I RITEM="" Q RESULT
;
S GREF=$$ROOT^DILFD(FREF,"",1)
S TEMP=$NA(^TMP("BQITEMP",UID)) K @TEMP
S IEN="",QFL=0
F S IEN=$O(@GREF@("AC",PTDFN,IEN),-1) Q:'IEN D
. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
. I TIEN'=RITEM 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 Q:VSDTM=0
. ; Set temporary
. S @TEMP@(VSDTM,VISIT,IEN)=$$GET1^DIQ(FREF,IEN,.04,"E")
;
S VSDTM="",QFL=0
F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM=""!(QFL) D
. S VISIT=""
. F S VISIT=$O(@TEMP@(VSDTM,VISIT),-1) Q:VISIT="" D Q:QFL
.. S IEN=""
.. F S IEN=$O(@TEMP@(VSDTM,VISIT,IEN),-1) Q:IEN="" D Q:QFL
... S $P(RESULT,U,2)=VSDTM,$P(RESULT,U,4)=VISIT_U_IEN
... S QFL=1,$P(RESULT,U,1)=1,$P(RESULT,U,3)=@TEMP@(VSDTM,VISIT,IEN)
K @TEMP
Q RESULT
;
OLOC() ;EP - Default Outside Location
NEW LCN,ULOC,ULCN,OLOC
S OLOC=""
S LCN=$O(^XTV(8989.51,"B","BEHOENCX OTHER LOCATION","")) I LCN="" Q OLOC
S ULOC=$G(DUZ(2)) I ULOC="" Q OLOC
S ULCN=$O(^XTV(8989.5,"AC",LCN,ULOC_";DIC(4,",""))
I ULCN'="" D
. S OLOC=^XTV(8989.5,"AC",LCN,ULOC_";DIC(4,",ULCN)
. S OLOC=OLOC_$C(29)_$P(^DIC(4,OLOC,0),"^",1)
Q OLOC
;
CLOC() ; EP - Current Default Location
NEW ULOC,LOC
S LOC=""
S ULOC=$G(DUZ(2)) I ULOC="" Q LOC
S LOC=ULOC_$C(29)_$P(^DIC(4,ULOC,0),"^",1)
Q LOC
BQIUTIL ;VNGT/HS/ALA-Utility Program ; 10 Nov 2008 9:53 AM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
MREC(PTDFN,FREF,ITEM) ;EP
+1 ; Find the most recent value for a specified item
+2 ; Input
+3 ; PTDFN - Patient IEN
+4 ; FREF - FileMan file number
+5 ; ITEM - Item (.01 external value)
+6 ;
+7 NEW RESULT,GREF,ENDT,IEN,TIEN,TEMP,QFL,XREF,IGREF,RITEM,BQPAR
+8 SET RESULT=0
+9 ;
+10 SET ITEM=$GET(ITEM,"")
+11 IF ITEM=""
QUIT RESULT
+12 DO FIELD^DID(FREF,.01,"","POINTER","BQPAR")
+13 SET IGREF=$GET(BQPAR("POINTER"))
SET XREF="""B"""
IF IGREF=""
QUIT RESULT
+14 SET IGREF=U_IGREF_XREF_")"
+15 SET RITEM=$ORDER(@IGREF@(ITEM,""))
IF RITEM=""
QUIT RESULT
+16 ;
+17 SET GREF=$$ROOT^DILFD(FREF,"",1)
+18 SET TEMP=$NAME(^TMP("BQITEMP",UID))
KILL @TEMP
+19 SET IEN=""
SET QFL=0
+20 FOR
SET IEN=$ORDER(@GREF@("AC",PTDFN,IEN),-1)
IF 'IEN
QUIT
Begin DoDot:1
+21 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+22 IF TIEN'=RITEM
QUIT
+23 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+24 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+25 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+26 ; Set temporary
+27 SET @TEMP@(VSDTM,VISIT,IEN)=$$GET1^DIQ(FREF,IEN,.04,"E")
End DoDot:1
+28 ;
+29 SET VSDTM=""
SET QFL=0
+30 FOR
SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
IF VSDTM=""!(QFL)
QUIT
Begin DoDot:1
+31 SET VISIT=""
+32 FOR
SET VISIT=$ORDER(@TEMP@(VSDTM,VISIT),-1)
IF VISIT=""
QUIT
Begin DoDot:2
+33 SET IEN=""
+34 FOR
SET IEN=$ORDER(@TEMP@(VSDTM,VISIT,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+35 SET $PIECE(RESULT,U,2)=VSDTM
SET $PIECE(RESULT,U,4)=VISIT_U_IEN
+36 SET QFL=1
SET $PIECE(RESULT,U,1)=1
SET $PIECE(RESULT,U,3)=@TEMP@(VSDTM,VISIT,IEN)
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
+37 KILL @TEMP
+38 QUIT RESULT
+39 ;
OLOC() ;EP - Default Outside Location
+1 NEW LCN,ULOC,ULCN,OLOC
+2 SET OLOC=""
+3 SET LCN=$ORDER(^XTV(8989.51,"B","BEHOENCX OTHER LOCATION",""))
IF LCN=""
QUIT OLOC
+4 SET ULOC=$GET(DUZ(2))
IF ULOC=""
QUIT OLOC
+5 SET ULCN=$ORDER(^XTV(8989.5,"AC",LCN,ULOC_";DIC(4,",""))
+6 IF ULCN'=""
Begin DoDot:1
+7 SET OLOC=^XTV(8989.5,"AC",LCN,ULOC_";DIC(4,",ULCN)
+8 SET OLOC=OLOC_$CHAR(29)_$PIECE(^DIC(4,OLOC,0),"^",1)
End DoDot:1
+9 QUIT OLOC
+10 ;
CLOC() ; EP - Current Default Location
+1 NEW ULOC,LOC
+2 SET LOC=""
+3 SET ULOC=$GET(DUZ(2))
IF ULOC=""
QUIT LOC
+4 SET LOC=ULOC_$CHAR(29)_$PIECE(^DIC(4,ULOC,0),"^",1)
+5 QUIT LOC
