- 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 Feb 18, 2025@23:11:42 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 ;
