- 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
