DGPFDBRS ;SLC/SS - PRF DBRS ; 12/26/17
;;5.3;Registration;**951**;Aug 13, 1993;Build 135
;
;The API to get the DBRS information
;Implements the ICR# 6874
;Parameters:
; DGDFN - patient's DFN
; DGRETARR - array to return information in the format:
; ARR(1)="DBRS#^DBRS date^DBRS other information"
; ARR(2)="DBRS#^DBRS date^DBRS other information"
; ...
; ARR(n)="DBRS#^DBRS date^DBRS other information"
; Note: the DBRS entries are listed in the reversed order.
; ARR(1) contains the latest entry
; DGFLAG - for which flag the DBRS entry data need to be returned
; Note: Default is "BEHAVIORAL"
;
;Returns:
; the latest entry ARR(1) - if any entries exist
;or
; "" - if no entries found
; "" - if the patient doesn't have a PRF flag
;
GETDBRS(DGDFN,DGRETARR,DGFLAG) ;
N DG2613,DGARR,DGIEN,DGCNT,DGCURFLG
S DGFLAG=$G(DGFLAG,"BEHAVIORAL")
S DG2613=0 F S DG2613=$O(^DGPF(26.13,"B",DGDFN,DG2613)) Q:+DG2613=0 D
. K DGARR
. D GETS^DIQ(26.13,DG2613_",",".02;2*","E","DGARR")
. S DGCURFLG=$G(DGARR(26.13,DG2613_",",.02,"E"))
. I DGCURFLG']"" Q
. S DGIEN="Z",DGCNT=0
. F S DGIEN=$O(DGARR(26.131,DGIEN),-1) Q:DGIEN']"" D
. . S DGCNT=DGCNT+1 S DGRETARR(DGCURFLG,DGCNT)=DGARR(26.131,DGIEN,.01,"E")_U_DGARR(26.131,DGIEN,.02,"E")
I '$D(DGRETARR) Q ""
Q $G(DGRETARR(DGFLAG,1))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFDBRS 1355 printed Dec 13, 2024@02:47:33 Page 2
DGPFDBRS ;SLC/SS - PRF DBRS ; 12/26/17
+1 ;;5.3;Registration;**951**;Aug 13, 1993;Build 135
+2 ;
+3 ;The API to get the DBRS information
+4 ;Implements the ICR# 6874
+5 ;Parameters:
+6 ; DGDFN - patient's DFN
+7 ; DGRETARR - array to return information in the format:
+8 ; ARR(1)="DBRS#^DBRS date^DBRS other information"
+9 ; ARR(2)="DBRS#^DBRS date^DBRS other information"
+10 ; ...
+11 ; ARR(n)="DBRS#^DBRS date^DBRS other information"
+12 ; Note: the DBRS entries are listed in the reversed order.
+13 ; ARR(1) contains the latest entry
+14 ; DGFLAG - for which flag the DBRS entry data need to be returned
+15 ; Note: Default is "BEHAVIORAL"
+16 ;
+17 ;Returns:
+18 ; the latest entry ARR(1) - if any entries exist
+19 ;or
+20 ; "" - if no entries found
+21 ; "" - if the patient doesn't have a PRF flag
+22 ;
GETDBRS(DGDFN,DGRETARR,DGFLAG) ;
+1 NEW DG2613,DGARR,DGIEN,DGCNT,DGCURFLG
+2 SET DGFLAG=$GET(DGFLAG,"BEHAVIORAL")
+3 SET DG2613=0
FOR
SET DG2613=$ORDER(^DGPF(26.13,"B",DGDFN,DG2613))
if +DG2613=0
QUIT
Begin DoDot:1
+4 KILL DGARR
+5 DO GETS^DIQ(26.13,DG2613_",",".02;2*","E","DGARR")
+6 SET DGCURFLG=$GET(DGARR(26.13,DG2613_",",.02,"E"))
+7 IF DGCURFLG']""
QUIT
+8 SET DGIEN="Z"
SET DGCNT=0
+9 FOR
SET DGIEN=$ORDER(DGARR(26.131,DGIEN),-1)
if DGIEN']""
QUIT
Begin DoDot:2
+10 SET DGCNT=DGCNT+1
SET DGRETARR(DGCURFLG,DGCNT)=DGARR(26.131,DGIEN,.01,"E")_U_DGARR(26.131,DGIEN,.02,"E")
End DoDot:2
End DoDot:1
+11 IF '$DATA(DGRETARR)
QUIT ""
+12 QUIT $GET(DGRETARR(DGFLAG,1))
+13 ;
