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
;
Q
;
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
Q
;
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
Q
;
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)
Q
;
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))
Q
;
CLEAR(ORY) ;Clear up the temp global
K ^TMP("DVBPRF",$J)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCPRF 3084 printed Dec 13, 2024@01:45:17 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 ;
