DGPFDBRS.m

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 ---DGPFDBRS   1355     printed  Apr 09, 2024@21:58:55                                                                                                                                                                                                    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      ;