Routine: DVBCPRF

DVBCPRF ;ALB/AG-Patient Record Flag ; 5/12/20 10:35am

 ;;2.7;AMIE;**220**;Apr 10, 1995 ;Build 9

 ;Per VHA Directive 6402 this routine should not be modified

FMT(ROOT) ; Format - Convert record flag data to displayable data

 ; Sets ^TMP("DVBPRF",$J,NN) with flag data for multiple flags

 N IDX,IX,CNT

 S (IDX,CNT)=0

 F  S IDX=$O(ROOT(IDX)) Q:'IDX  D

 . S ^TMP("DVBPRF",$J,IDX,"FLAG")=$P($G(ROOT(IDX,"FLAG")),U,2)

 . S ^TMP("DVBPRF",$J,IDX,"CATEGORY")=$P($G(ROOT(IDX,"CATEGORY")),U,2)

 . S CNT=CNT+1,^TMP("DVBPRF",$J,IDX,CNT)="Flag Name:               "_$P($G(ROOT(IDX,"FLAG")),U,2)

 . I $D(ROOT(IDX,"NARR")) D

 . . S CNT=CNT+1,^TMP("DVBPRF",$J,IDX,CNT)="            "

 . . S CNT=CNT+1,^TMP("DVBPRF",$J,IDX,CNT)="Assignment Narrative:   "

 . . S IX=0 F  S IX=$O(ROOT(IDX,"NARR",IX)) Q:'IX  D

 . . . S CNT=CNT+1,^TMP("DVBPRF",$J,IDX,CNT)=$G(ROOT(IDX,"NARR",IX,0))

 . S CNT=CNT+1,^TMP("DVBPRF",$J,IDX,CNT)="            "

 . ; -- Assignment Details:

 . S CNT=CNT+1,^TMP("DVBPRF",$J,IDX,CNT)="Flag Type:               "_$P($G(ROOT(IDX,"FLAGTYPE")),U,2)

 . S CNT=CNT+1,^TMP("DVBPRF",$J,IDX,CNT)="Flag Category:           "_$P($G(ROOT(IDX,"CATEGORY")),U,2)

 . S CNT=CNT+1,^TMP("DVBPRF",$J,IDX,CNT)="Assignment Status:       "_"Active"

 . S CNT=CNT+1,^TMP("DVBPRF",$J,IDX,CNT)="Initial Assigned Date:   "_$P($G(ROOT(IDX,"ASSIGNDT")),U,2)

 . S CNT=CNT+1,^TMP("DVBPRF",$J,IDX,CNT)="Approved by:             "_$P($G(ROOT(IDX,"APPRVBY")),U,2)

 . S CNT=CNT+1,^TMP("DVBPRF",$J,IDX,CNT)="Next Review Date:        "_$P($G(ROOT(IDX,"REVIEWDT")),U,2)

 . S CNT=CNT+1,^TMP("DVBPRF",$J,IDX,CNT)="Owner Site:              "_$P($G(ROOT(IDX,"OWNER")),U,2)

 . S CNT=CNT+1,^TMP("DVBPRF",$J,IDX,CNT)="Originating Site:        "_$P($G(ROOT(IDX,"ORIGSITE")),U,2)

 K ROOT

HASFLG(DVBY,PTDFN) ;Does patient PTDFN have flags

 ;     DBIA 3860: $$GETACT^DGPFAPI(PTDFN,.FLGDATA)

 ; Returns array DVBY listing active assigned flags

 ; Array DVBY has form:

 ;   DVBY(flagID) = flagID^flagname,CAT1

 ;      where CAT1 is 1 if flag is cat 1, 0 if cat 2

 ; DVBY = Num of items returned in array ORY = num of flags

 I '$L($TEXT(GETACT^DGPFAPI)) S DVBY=0 Q

 N IDY,PRFARR,CAT1

 K ^TMP("DVBPRF",$J)

 S DVBY=$$GETACT^DGPFAPI(PTDFN,"PRFARR")

 Q:'DVBY

 D FMT(.@("PRFARR")) ; Sets ^TMP("DVBPRF"

 S IDY=0 F  S IDY=$O(^TMP("DVBPRF",$J,IDY)) Q:'IDY  D

 . S DVBY(IDY)=IDY_U_$G(^TMP("DVBPRF",$J,IDY,"FLAG"))

 . S CAT1=0

 . I $G(^TMP("DVBPRF",$J,IDY,"CATEGORY"))="I (NATIONAL)" S CAT1=1

 . S DVBY(IDY)=DVBY(IDY)_U_CAT1

TRIGRPOP(POPUP,PTDFN) ;Should the flag display pop up upon patient selection

 ;   1 if pt has any active flags, either Cat I or Cat II

 ;   0 otherwise

 N PRFARR

 S POPUP=$S($$GETACT^DGPFAPI(PTDFN,"PRFARR"):1,1:0)

GETFLG(DVBY,PTDFN,FLAGID) ;Return detailed flag info for flag FLAGID

 I '$D(^TMP("DVBPRF",$J,FLAGID)) Q

 N IX,CNT

 S (IX,CNT)=0

 F  S IX=$O(^TMP("DVBPRF",$J,FLAGID,IX)) Q:'IX  D

 . S CNT=CNT+1,DVBY(CNT)=$G(^TMP("DVBPRF",$J,FLAGID,IX))

CLEAR(ORY) ;Clear up the temp global

 K ^TMP("DVBPRF",$J)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCPRF   3084     printed  Apr 09, 2024@20:48:30                                                                                                                                                                                                     Page 2

DVBCPRF   ;ALB/AG-Patient Record Flag ; 5/12/20 10:35am

 +1       ;;2.7;AMIE;**220**;Apr 10, 1995 ;Build 9

 +2       ;Per VHA Directive 6402 this routine should not be modified

 +3       ;

 +4        QUIT

 +5       ;

FMT(ROOT) ; Format - Convert record flag data to displayable data

 +1       ; Sets ^TMP("DVBPRF",$J,NN) with flag data for multiple flags

 +2        NEW IDX,IX,CNT

 +3        SET (IDX,CNT)=0

 +4        FOR

               SET IDX=$ORDER(ROOT(IDX))

               if 'IDX

                   QUIT

               Begin DoDot:1

 +5                SET ^TMP("DVBPRF",$JOB,IDX,"FLAG")=$PIECE($GET(ROOT(IDX,"FLAG")),U,2)

 +6                SET ^TMP("DVBPRF",$JOB,IDX,"CATEGORY")=$PIECE($GET(ROOT(IDX,"CATEGORY")),U,2)

 +7                SET CNT=CNT+1

                   SET ^TMP("DVBPRF",$JOB,IDX,CNT)="Flag Name:               "_$PIECE($GET(ROOT(IDX,"FLAG")),U,2)

 +8                IF $DATA(ROOT(IDX,"NARR"))

                       Begin DoDot:2

 +9                        SET CNT=CNT+1

                           SET ^TMP("DVBPRF",$JOB,IDX,CNT)="            "

 +10                       SET CNT=CNT+1

                           SET ^TMP("DVBPRF",$JOB,IDX,CNT)="Assignment Narrative:   "

 +11                       SET IX=0

FOR

                               SET IX=$ORDER(ROOT(IDX,"NARR",IX))

                               if 'IX

                                   QUIT

                               Begin DoDot:3

 +12                               SET CNT=CNT+1

                                   SET ^TMP("DVBPRF",$JOB,IDX,CNT)=$GET(ROOT(IDX,"NARR",IX,0))

                               End DoDot:3

                       End DoDot:2

 +13               SET CNT=CNT+1

                   SET ^TMP("DVBPRF",$JOB,IDX,CNT)="            "

 +14      ; -- Assignment Details:

 +15               SET CNT=CNT+1

                   SET ^TMP("DVBPRF",$JOB,IDX,CNT)="Flag Type:               "_$PIECE($GET(ROOT(IDX,"FLAGTYPE")),U,2)

 +16               SET CNT=CNT+1

                   SET ^TMP("DVBPRF",$JOB,IDX,CNT)="Flag Category:           "_$PIECE($GET(ROOT(IDX,"CATEGORY")),U,2)

 +17               SET CNT=CNT+1

                   SET ^TMP("DVBPRF",$JOB,IDX,CNT)="Assignment Status:       "_"Active"

 +18               SET CNT=CNT+1

                   SET ^TMP("DVBPRF",$JOB,IDX,CNT)="Initial Assigned Date:   "_$PIECE($GET(ROOT(IDX,"ASSIGNDT")),U,2)

 +19               SET CNT=CNT+1

                   SET ^TMP("DVBPRF",$JOB,IDX,CNT)="Approved by:             "_$PIECE($GET(ROOT(IDX,"APPRVBY")),U,2)

 +20               SET CNT=CNT+1

                   SET ^TMP("DVBPRF",$JOB,IDX,CNT)="Next Review Date:        "_$PIECE($GET(ROOT(IDX,"REVIEWDT")),U,2)

 +21               SET CNT=CNT+1

                   SET ^TMP("DVBPRF",$JOB,IDX,CNT)="Owner Site:              "_$PIECE($GET(ROOT(IDX,"OWNER")),U,2)

 +22               SET CNT=CNT+1

                   SET ^TMP("DVBPRF",$JOB,IDX,CNT)="Originating Site:        "_$PIECE($GET(ROOT(IDX,"ORIGSITE")),U,2)

               End DoDot:1

 +23       KILL ROOT

 +24       QUIT

 +25      ;

HASFLG(DVBY,PTDFN) ;Does patient PTDFN have flags

 +1       ;     DBIA 3860: $$GETACT^DGPFAPI(PTDFN,.FLGDATA)

 +2       ; Returns array DVBY listing active assigned flags

 +3       ; Array DVBY has form:

 +4       ;   DVBY(flagID) = flagID^flagname,CAT1

 +5       ;      where CAT1 is 1 if flag is cat 1, 0 if cat 2

 +6       ; DVBY = Num of items returned in array ORY = num of flags

 +7        IF '$LENGTH($TEXT(GETACT^DGPFAPI))

               SET DVBY=0

               QUIT

 +8        NEW IDY,PRFARR,CAT1

 +9        KILL ^TMP("DVBPRF",$JOB)

 +10       SET DVBY=$$GETACT^DGPFAPI(PTDFN,"PRFARR")

 +11       if 'DVBY

               QUIT

 +12      ; Sets ^TMP("DVBPRF"

           DO FMT(.@("PRFARR"))

 +13       SET IDY=0

FOR

               SET IDY=$ORDER(^TMP("DVBPRF",$JOB,IDY))

               if 'IDY

                   QUIT

               Begin DoDot:1

 +14               SET DVBY(IDY)=IDY_U_$GET(^TMP("DVBPRF",$JOB,IDY,"FLAG"))

 +15               SET CAT1=0

 +16               IF $GET(^TMP("DVBPRF",$JOB,IDY,"CATEGORY"))="I (NATIONAL)"

                       SET CAT1=1

 +17               SET DVBY(IDY)=DVBY(IDY)_U_CAT1

               End DoDot:1

 +18       QUIT

 +19      ;

TRIGRPOP(POPUP,PTDFN) ;Should the flag display pop up upon patient selection

 +1       ;

 +2       ;   1 if pt has any active flags, either Cat I or Cat II

 +3       ;   0 otherwise

 +4        NEW PRFARR

 +5        SET POPUP=$SELECT($$GETACT^DGPFAPI(PTDFN,"PRFARR"):1,1:0)

 +6        QUIT

 +7       ;

GETFLG(DVBY,PTDFN,FLAGID) ;Return detailed flag info for flag FLAGID

 +1        IF '$DATA(^TMP("DVBPRF",$JOB,FLAGID))

               QUIT

 +2        NEW IX,CNT

 +3        SET (IX,CNT)=0

 +4        FOR

               SET IX=$ORDER(^TMP("DVBPRF",$JOB,FLAGID,IX))

               if 'IX

                   QUIT

               Begin DoDot:1

 +5                SET CNT=CNT+1

                   SET DVBY(CNT)=$GET(^TMP("DVBPRF",$JOB,FLAGID,IX))

               End DoDot:1

 +6        QUIT

 +7       ;

CLEAR(ORY) ;Clear up the temp global

 +1        KILL ^TMP("DVBPRF",$JOB)

 +2        QUIT

 +3       ;

DVBCPRF.m