DGPFLF1 ;ALB/KCL - PRF FLAG MANAGEMENT BUILD LIST AREA ; 3/11/03
;;5.3;Registration;**425**;Aug 13, 1993
;
;no direct entry
QUIT
;
EN(DGARY,DGCAT,DGSRTBY,DGCNT) ;Entry point to build list area for PRF Flags.
;
; The following variables are 'system wide variables' in the
; DGPF RECORD FLAG MANAGEMENT List Manager application:
; Input:
; DGARY - global array subscript
; DGCAT - flag category (1=National, 2=Local)
; DGSRTBY - list sort by criteria (N=Flag Name, T=Flage Type)
;
; Output:
; DGCNT - number of lines in the list
;
;display wait msg
D WAIT^DICD
;
;retrieve all flags for the category specified
D GET(DGARY,DGCAT,DGSRTBY)
;
;build list area for flag screen
D BLD(DGSRTBY,.DGCNT)
;
;if no entries in list, display message in list area
I 'DGCNT D
. D SET^DGPFLMU1(DGARY,1,"",1,,,.DGCNT)
. D SET^DGPFLMU1(DGARY,2,"There are currently no flags on file to display.",4,$G(IOINHI),$G(IOINORM),.DGCNT)
;
Q
;
;
GET(DGARY,DGCAT,DGSRTBY) ;Get flag entries for display.
;
; Input:
; DGARY - global array subscript
; DGCAT - flag category (1=National, 2=Local)
; DGSRTBY - list sort by criteria (N=Flag Name, T=Flage Type)
;
; Output: None
;
N DGFILE ;file root of LOCAL or NATIONAL flag file
N DGFLAG ;local array used to hold flag record
N DGIEN ;ien of record in LOCAL or NATIONAL flag file
N DGVPTR ;IEN of record in PRF NATIONAL FLAG or PRF LOCAL FLAG file
N DGRSULT
;
;determine LOCAL or NATIONAL flag file
S DGFILE=$S(DGCAT=1:"^DGPF(26.15)",DGCAT=2:"^DGPF(26.11)",1:0)
;
;loop through each ien of flag file determined by value of DGFILE
S DGIEN=0 F S DGIEN=$O(@DGFILE@(DGIEN)) Q:'DGIEN D
. K DGFLAG
. ;- if national, get flag into DGFLAG array
. I DGCAT=1 D Q:'$G(DGRSULT)
. . S DGRSULT=$$GETNF^DGPFANF(DGIEN,.DGFLAG)
. . S:DGRSULT DGVPTR=DGIEN_";DGPF(26.15,"
. ;
. ;- if local, get flag into DGFLAG array
. I DGCAT=2 D Q:'$G(DGRSULT)
. . S DGRSULT=$$GETLF^DGPFALF(DGIEN,.DGFLAG)
. . S:DGRSULT DGVPTR=DGIEN_";DGPF(26.11,"
. ;
. ;- set flag entry into sorted output array
. D SORT(DGVPTR,DGSRTBY,DGIEN,.DGFLAG)
;
Q
;
;
SORT(DGVPTR,DGSRTBY,DGIEN,DGFLAG) ;Set flag data into sorted output array based on the sort criteria passed.
;
; Input:
; DGVPTR - IEN of record in PRF NATIONAL FLAG or PRF LOCAL FLAG file
; [ex: "1;DGPF(26.15,"]
; DGSRTBY - list sort by criteria (N=Flag Name, T=Flage Type)
; DGIEN - ien of record in LOCAL or NATIONAL flag file
; DGFLAG - local array containing flag record
;
; Output:
; Temporary global with following structure -
; Flag list sorted by flag name:
; ^TMP("DGPFSORT",$J,<status>,<flag name>,<ien>)=<var pointer>^<flag name>^<flag type>^<flag status>
; OR
; Flag list sorted by flag type:
; ^TMP("DGPFSORT",$J,<status>,<flag type>,<ien>)=<var pointer>^<flag name>^<flag type>^<flag status>
;
I DGSRTBY="N" D ;flag name
. S ^TMP("DGPFSORT",$J,$P($G(DGFLAG("STAT")),U),$P($G(DGFLAG("FLAG")),U,2),DGIEN)=DGVPTR_U_$P($G(DGFLAG("FLAG")),U,2)_U_$P($G(DGFLAG("TYPE")),U,2)_U_$P($G(DGFLAG("STAT")),U,2)
E D ;else flag type
. S ^TMP("DGPFSORT",$J,$P($G(DGFLAG("STAT")),U),$P($G(DGFLAG("TYPE")),U,2),DGIEN)=DGVPTR_U_$P($G(DGFLAG("FLAG")),U,2)_U_$P($G(DGFLAG("TYPE")),U,2)_U_$P($G(DGFLAG("STAT")),U,2)
;
Q
;
;
BLD(DGSRTBY,DGCNT) ;Build list area for flag screen.
;
; Input:
; DGSRTBY - list sort by criteria (N=Flag Name, T=Flage Type)
;
; Output:
; DGCNT - number of lines in the list
;
N DGFIEN ;^tmp global subscript (flag ien)
N DGLINE ;line counter
N DGNAME ;flag name
N DGNUM ;list selction number
N DGSI ;flag status internal value
N DGSTAT ;flag status
N DGSUB ;^tmp global subscript (flag name or type)
N DGTYPE ;flag type
N DGVPTR ;IEN of record in PRF NATIONAL FLAG or PRF LOCAL FLAG file
; [ex: "1;DGPF(26.15,"]
N DGTEMP ;sort array root
;
;init line counter and selection number
S (DGLINE,DGNUM)=0
;- loop through ^TMP global by status, active (1) then inactive (0)
F DGSI=1,0 D
. ;- loop through sort selection by flag name or flag type
. S DGSUB=$S(DGSRTBY="N":"",1:0)
. F S DGSUB=$O(^TMP("DGPFSORT",$J,DGSI,DGSUB)) Q:DGSUB="" D
. . ;- loop through flag file ien's
. . S DGFIEN=0
. . F S DGFIEN=$O(^TMP("DGPFSORT",$J,DGSI,DGSUB,DGFIEN)) Q:'DGFIEN D
. . . ;-- get flag data fields from entry in ^TMP global
. . . S DGTEMP=$NA(^TMP("DGPFSORT",$J))
. . . S DGVPTR=$P($G(@DGTEMP@(DGSI,DGSUB,DGFIEN)),U) ;flag IEN
. . . S DGNAME=$P($G(@DGTEMP@(DGSI,DGSUB,DGFIEN)),U,2) ;flag name
. . . S DGTYPE=$P($G(@DGTEMP@(DGSI,DGSUB,DGFIEN)),U,3) ;flag type
. . . S DGSTAT=$P($G(@DGTEMP@(DGSI,DGSUB,DGFIEN)),U,4) ;flag status
. . . ;
. . . ;-- increment selection number
. . . S DGNUM=DGNUM+1
. . . ;
. . . ;-- increment line counter
. . . S DGLINE=DGLINE+1
. . . ;
. . . ;-- set line into list area
. . . D SET(DGARY,DGLINE,DGNUM,1,,,DGVPTR,DGNUM,.DGCNT)
. . . D SET(DGARY,DGLINE,DGNAME,6,,,DGVPTR,DGNUM,.DGCNT)
. . . D SET(DGARY,DGLINE,DGTYPE,38,,,DGVPTR,DGNUM,.DGCNT)
. . . D SET(DGARY,DGLINE,DGSTAT,65,,,DGVPTR,DGNUM,.DGCNT)
;
Q
;
;
SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGVPTR,DGNUM,DGCNT) ;This procedure will set the lines of flag details in the LM display area.
;
; Input:
; DGARY - global array subscript
; DGLINE - line number
; DGTEXT - text
; DGVPTR - (optional) IEN of record in PRF NATIONAL FLAG or PRF LOCAL
; FLAG file [ex: "1;DGPF(26.15,"]
; DGNUM - (optional) selection number
; DGCOL - starting column
; DGON - highlighting on
; DGOFF - highlighting off
;
; Output:
; DGCNT - number of lines in the list, pass by reference
;
N DGX
S:DGLINE>DGCNT DGCNT=DGLINE
S DGX=$S($D(^TMP(DGARY,$J,DGLINE,0)):^(0),1:"")
S ^TMP(DGARY,$J,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$L(DGTEXT))
D:$G(DGON)]""!($G(DGOFF)]"") CNTRL^VALM10(DGLINE,DGCOL,$L(DGTEXT),$G(DGON),$G(DGOFF))
;
;associate flag ien with list item for flag selection
S:($G(DGVPTR)]"")&($G(DGNUM)) ^TMP(DGARY,$J,"IDX",DGLINE,DGNUM)=""
S:($G(DGVPTR)]"")&($G(DGNUM)) ^TMP(DGARY,$J,"IDX",DGNUM)=DGVPTR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFLF1 6316 printed Sep 23, 2025@20:23:55 Page 2
DGPFLF1 ;ALB/KCL - PRF FLAG MANAGEMENT BUILD LIST AREA ; 3/11/03
+1 ;;5.3;Registration;**425**;Aug 13, 1993
+2 ;
+3 ;no direct entry
+4 QUIT
+5 ;
EN(DGARY,DGCAT,DGSRTBY,DGCNT) ;Entry point to build list area for PRF Flags.
+1 ;
+2 ; The following variables are 'system wide variables' in the
+3 ; DGPF RECORD FLAG MANAGEMENT List Manager application:
+4 ; Input:
+5 ; DGARY - global array subscript
+6 ; DGCAT - flag category (1=National, 2=Local)
+7 ; DGSRTBY - list sort by criteria (N=Flag Name, T=Flage Type)
+8 ;
+9 ; Output:
+10 ; DGCNT - number of lines in the list
+11 ;
+12 ;display wait msg
+13 DO WAIT^DICD
+14 ;
+15 ;retrieve all flags for the category specified
+16 DO GET(DGARY,DGCAT,DGSRTBY)
+17 ;
+18 ;build list area for flag screen
+19 DO BLD(DGSRTBY,.DGCNT)
+20 ;
+21 ;if no entries in list, display message in list area
+22 IF 'DGCNT
Begin DoDot:1
+23 DO SET^DGPFLMU1(DGARY,1,"",1,,,.DGCNT)
+24 DO SET^DGPFLMU1(DGARY,2,"There are currently no flags on file to display.",4,$GET(IOINHI),$GET(IOINORM),.DGCNT)
End DoDot:1
+25 ;
+26 QUIT
+27 ;
+28 ;
GET(DGARY,DGCAT,DGSRTBY) ;Get flag entries for display.
+1 ;
+2 ; Input:
+3 ; DGARY - global array subscript
+4 ; DGCAT - flag category (1=National, 2=Local)
+5 ; DGSRTBY - list sort by criteria (N=Flag Name, T=Flage Type)
+6 ;
+7 ; Output: None
+8 ;
+9 ;file root of LOCAL or NATIONAL flag file
NEW DGFILE
+10 ;local array used to hold flag record
NEW DGFLAG
+11 ;ien of record in LOCAL or NATIONAL flag file
NEW DGIEN
+12 ;IEN of record in PRF NATIONAL FLAG or PRF LOCAL FLAG file
NEW DGVPTR
+13 NEW DGRSULT
+14 ;
+15 ;determine LOCAL or NATIONAL flag file
+16 SET DGFILE=$SELECT(DGCAT=1:"^DGPF(26.15)",DGCAT=2:"^DGPF(26.11)",1:0)
+17 ;
+18 ;loop through each ien of flag file determined by value of DGFILE
+19 SET DGIEN=0
FOR
SET DGIEN=$ORDER(@DGFILE@(DGIEN))
if 'DGIEN
QUIT
Begin DoDot:1
+20 KILL DGFLAG
+21 ;- if national, get flag into DGFLAG array
+22 IF DGCAT=1
Begin DoDot:2
+23 SET DGRSULT=$$GETNF^DGPFANF(DGIEN,.DGFLAG)
+24 if DGRSULT
SET DGVPTR=DGIEN_";DGPF(26.15,"
End DoDot:2
if '$GET(DGRSULT)
QUIT
+25 ;
+26 ;- if local, get flag into DGFLAG array
+27 IF DGCAT=2
Begin DoDot:2
+28 SET DGRSULT=$$GETLF^DGPFALF(DGIEN,.DGFLAG)
+29 if DGRSULT
SET DGVPTR=DGIEN_";DGPF(26.11,"
End DoDot:2
if '$GET(DGRSULT)
QUIT
+30 ;
+31 ;- set flag entry into sorted output array
+32 DO SORT(DGVPTR,DGSRTBY,DGIEN,.DGFLAG)
End DoDot:1
+33 ;
+34 QUIT
+35 ;
+36 ;
SORT(DGVPTR,DGSRTBY,DGIEN,DGFLAG) ;Set flag data into sorted output array based on the sort criteria passed.
+1 ;
+2 ; Input:
+3 ; DGVPTR - IEN of record in PRF NATIONAL FLAG or PRF LOCAL FLAG file
+4 ; [ex: "1;DGPF(26.15,"]
+5 ; DGSRTBY - list sort by criteria (N=Flag Name, T=Flage Type)
+6 ; DGIEN - ien of record in LOCAL or NATIONAL flag file
+7 ; DGFLAG - local array containing flag record
+8 ;
+9 ; Output:
+10 ; Temporary global with following structure -
+11 ; Flag list sorted by flag name:
+12 ; ^TMP("DGPFSORT",$J,<status>,<flag name>,<ien>)=<var pointer>^<flag name>^<flag type>^<flag status>
+13 ; OR
+14 ; Flag list sorted by flag type:
+15 ; ^TMP("DGPFSORT",$J,<status>,<flag type>,<ien>)=<var pointer>^<flag name>^<flag type>^<flag status>
+16 ;
+17 ;flag name
IF DGSRTBY="N"
Begin DoDot:1
+18 SET ^TMP("DGPFSORT",$JOB,$PIECE($GET(DGFLAG("STAT")),U),$PIECE($GET(DGFLAG("FLAG")),U,2),DGIEN)=DGVPTR_U_$PIECE($GET(DGFLAG("FLAG")),U,2)_U_$PIECE($GET(DGFLAG("TYPE")),U,2)_U_$PIECE($GET(DGFLAG("STAT")),U,2)
End DoDot:1
+19 ;else flag type
IF '$TEST
Begin DoDot:1
+20 SET ^TMP("DGPFSORT",$JOB,$PIECE($GET(DGFLAG("STAT")),U),$PIECE($GET(DGFLAG("TYPE")),U,2),DGIEN)=DGVPTR_U_$PIECE($GET(DGFLAG("FLAG")),U,2)_U_$PIECE($GET(DGFLAG("TYPE")),U,2)_U_$PIECE($GET(DGFLAG("STAT")),U,2)
End DoDot:1
+21 ;
+22 QUIT
+23 ;
+24 ;
BLD(DGSRTBY,DGCNT) ;Build list area for flag screen.
+1 ;
+2 ; Input:
+3 ; DGSRTBY - list sort by criteria (N=Flag Name, T=Flage Type)
+4 ;
+5 ; Output:
+6 ; DGCNT - number of lines in the list
+7 ;
+8 ;^tmp global subscript (flag ien)
NEW DGFIEN
+9 ;line counter
NEW DGLINE
+10 ;flag name
NEW DGNAME
+11 ;list selction number
NEW DGNUM
+12 ;flag status internal value
NEW DGSI
+13 ;flag status
NEW DGSTAT
+14 ;^tmp global subscript (flag name or type)
NEW DGSUB
+15 ;flag type
NEW DGTYPE
+16 ;IEN of record in PRF NATIONAL FLAG or PRF LOCAL FLAG file
NEW DGVPTR
+17 ; [ex: "1;DGPF(26.15,"]
+18 ;sort array root
NEW DGTEMP
+19 ;
+20 ;init line counter and selection number
+21 SET (DGLINE,DGNUM)=0
+22 ;- loop through ^TMP global by status, active (1) then inactive (0)
+23 FOR DGSI=1,0
Begin DoDot:1
+24 ;- loop through sort selection by flag name or flag type
+25 SET DGSUB=$SELECT(DGSRTBY="N":"",1:0)
+26 FOR
SET DGSUB=$ORDER(^TMP("DGPFSORT",$JOB,DGSI,DGSUB))
if DGSUB=""
QUIT
Begin DoDot:2
+27 ;- loop through flag file ien's
+28 SET DGFIEN=0
+29 FOR
SET DGFIEN=$ORDER(^TMP("DGPFSORT",$JOB,DGSI,DGSUB,DGFIEN))
if 'DGFIEN
QUIT
Begin DoDot:3
+30 ;-- get flag data fields from entry in ^TMP global
+31 SET DGTEMP=$NAME(^TMP("DGPFSORT",$JOB))
+32 ;flag IEN
SET DGVPTR=$PIECE($GET(@DGTEMP@(DGSI,DGSUB,DGFIEN)),U)
+33 ;flag name
SET DGNAME=$PIECE($GET(@DGTEMP@(DGSI,DGSUB,DGFIEN)),U,2)
+34 ;flag type
SET DGTYPE=$PIECE($GET(@DGTEMP@(DGSI,DGSUB,DGFIEN)),U,3)
+35 ;flag status
SET DGSTAT=$PIECE($GET(@DGTEMP@(DGSI,DGSUB,DGFIEN)),U,4)
+36 ;
+37 ;-- increment selection number
+38 SET DGNUM=DGNUM+1
+39 ;
+40 ;-- increment line counter
+41 SET DGLINE=DGLINE+1
+42 ;
+43 ;-- set line into list area
+44 DO SET(DGARY,DGLINE,DGNUM,1,,,DGVPTR,DGNUM,.DGCNT)
+45 DO SET(DGARY,DGLINE,DGNAME,6,,,DGVPTR,DGNUM,.DGCNT)
+46 DO SET(DGARY,DGLINE,DGTYPE,38,,,DGVPTR,DGNUM,.DGCNT)
+47 DO SET(DGARY,DGLINE,DGSTAT,65,,,DGVPTR,DGNUM,.DGCNT)
End DoDot:3
End DoDot:2
End DoDot:1
+48 ;
+49 QUIT
+50 ;
+51 ;
SET(DGARY,DGLINE,DGTEXT,DGCOL,DGON,DGOFF,DGVPTR,DGNUM,DGCNT) ;This procedure will set the lines of flag details in the LM display area.
+1 ;
+2 ; Input:
+3 ; DGARY - global array subscript
+4 ; DGLINE - line number
+5 ; DGTEXT - text
+6 ; DGVPTR - (optional) IEN of record in PRF NATIONAL FLAG or PRF LOCAL
+7 ; FLAG file [ex: "1;DGPF(26.15,"]
+8 ; DGNUM - (optional) selection number
+9 ; DGCOL - starting column
+10 ; DGON - highlighting on
+11 ; DGOFF - highlighting off
+12 ;
+13 ; Output:
+14 ; DGCNT - number of lines in the list, pass by reference
+15 ;
+16 NEW DGX
+17 if DGLINE>DGCNT
SET DGCNT=DGLINE
+18 SET DGX=$SELECT($DATA(^TMP(DGARY,$JOB,DGLINE,0)):^(0),1:"")
+19 SET ^TMP(DGARY,$JOB,DGLINE,0)=$$SETSTR^VALM1(DGTEXT,DGX,DGCOL,$LENGTH(DGTEXT))
+20 if $GET(DGON)]""!($GET(DGOFF)]"")
DO CNTRL^VALM10(DGLINE,DGCOL,$LENGTH(DGTEXT),$GET(DGON),$GET(DGOFF))
+21 ;
+22 ;associate flag ien with list item for flag selection
+23 if ($GET(DGVPTR)]"")&($GET(DGNUM))
SET ^TMP(DGARY,$JOB,"IDX",DGLINE,DGNUM)=""
+24 if ($GET(DGVPTR)]"")&($GET(DGNUM))
SET ^TMP(DGARY,$JOB,"IDX",DGNUM)=DGVPTR
+25 QUIT
