DGPFLFD1 ;ALB/KCL - PRF DISPLAY FLAG DETAIL BUILD LIST AREA ; 6/9/04 2:49pm
;;5.3;Registration;**425,554**;Aug 13, 1993
;
;no direct entry
QUIT
;
EN(DGARY,DGPFIEN,DGCNT) ;Entry point to build flag detail list area.
;
; Input:
; DGARY - global array subscript
; DGPFIEN - IEN of record in PRF NATIONAL FLAG or PRF LOCAL
; FLAG file [ex: "1;DGPF(26.15,"]
;
; Output:
; DGCNT - number of lines in the list, pass by reference
;
N DGPFF ;flag array
N DGPFFH ;flag history array
N DGFHIENS ;contains flag history ien's
N DGFHIEN ;flag history ien
N DGHISCNT ;history record counter
N DGLINE ;line counter
N DGSUB ;subscript of flag history ien's
;
;quit if required input paramater not passed
Q:'$G(DGPFIEN)
;
;init variables
S (DGCNT,DGLINE,DGHISCNT)=0
K DGPFF
;
;get flag into DGPFF array
Q:'$$GETFLAG^DGPFUT1(DGPFIEN,.DGPFF)
S DGPFF("PTR")=DGPFIEN
;
;build 'Flag Details' list area
D FLAGDET(DGARY,.DGPFF,.DGLINE,.DGCNT)
;
;quit if NATIONAL flag, they don't have a history
Q:DGPFF("PTR")'["26.11"
;
;set history heading into list area
D HISTHDR(DGARY,.DGLINE,.DGCNT)
;
;get all history ien's associated with the flag
K DGFHIENS
Q:'$$GETALLDT^DGPFALH(+DGPFF("PTR"),.DGFHIENS)
;
;reverse loop through each flag history ien
S DGSUB=9999999.999999
F S DGSUB=$O(DGFHIENS(DGSUB),-1) Q:DGSUB="" D
. S DGFHIEN=$G(DGFHIENS(DGSUB))
. K DGPFFH
. ;- for each ien, get flag history into DGPFFH array
. I $$GETHIST^DGPFALH(DGFHIEN,.DGPFFH) D
. . ;
. . ;-- count of history records
. . S DGHISCNT=DGHISCNT+1
. . ;
. . ;-- build flag history details list area
. . D HISTDET(DGARY,.DGPFFH,.DGLINE,DGHISCNT,.DGCNT)
;
Q
;
;
FLAGDET(DGARY,DGPFF,DGLINE,DGCNT) ;This procedure will build the lines of FLAG details in the list area.
;
; Input:
; DGARY - global array subscript
; DGPFF - flag array, pass by reference
; DGLINE - line counter
;
; Output:
; DGCNT - number of lines in the list, pass by reference
;
;temp vars used
N DGSUB ;array subscript
N DGTEMP ;temp text holder
N DGCOUNT ;principal investigator count
;
;set flag name
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"Flag Name: "_$P($G(DGPFF("FLAG")),U,2),11,,,,,.DGCNT)
;
;set flag category
S DGLINE=DGLINE+1
S DGTEMP=$S(DGPFF("PTR")["26.11":"II (LOCAL)",DGPFF("PTR")["26.15":"I (NATIONAL)",1:"UNKNOWN")
D SET^DGPFLF1(DGARY,DGLINE,"Flag Category: "_DGTEMP,7,,,,,.DGCNT)
;
;set flag type
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"Flag Type: "_$P($G(DGPFF("TYPE")),U,2),11,,,,,.DGCNT)
;
;set flag status
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"Flag Status: "_$P($G(DGPFF("STAT")),U,2),9,,,,,.DGCNT)
;
;set flag review frequency
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"Review Freq Days: "_$P($G(DGPFF("REVFREQ")),U,2),4,,,,,.DGCNT)
;
;set notification days
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"Notification Days: "_$P($G(DGPFF("NOTIDAYS")),U,2),3,,,,,.DGCNT)
;
;set flag review mail group
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"Review Mail Group: "_$P($G(DGPFF("REVGRP")),U,2),3,,,,,.DGCNT)
;
;set associated progress note title
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"Progress Note Title: "_$E($P($G(DGPFF("TIUTITLE")),U,2),1,59),1,,,,,.DGCNT)
;
;set if principal investigator(s)
I $D(DGPFF("PRININV")) D
. S (DGSUB,DGTEMP)=""
. S DGCOUNT=1
. F S DGSUB=$O(DGPFF("PRININV",DGSUB)) Q:'DGSUB D
. . Q:$G(DGPFF("PRININV",DGSUB,0))="@"
. . I DGCOUNT=1 D
. . . S DGLINE=DGLINE+1
. . . S DGTEMP="Principal"
. . . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,5,,,,,.DGCNT)
. . . S DGLINE=DGLINE+1
. . . S DGTEMP="Investigator(s): "_$P($G(DGPFF("PRININV",DGSUB,0)),U,2)
. . . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,5,,,,,.DGCNT)
. . I DGCOUNT>1 D
. . . S DGTEMP=$P($G(DGPFF("PRININV",DGSUB,0)),U,2)
. . . S DGLINE=DGLINE+1
. . . D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,22,,,,,.DGCNT)
. . S DGCOUNT=DGCOUNT+1
;
;set flag description
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"Flag Description:",1,IORVON,IORVOFF,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"-----------------",1,,,,,.DGCNT)
I '$D(DGPFF("DESC",1,0)) D Q
. S DGLINE=DGLINE+1
. D SET^DGPFLF1(DGARY,DGLINE,"Unknown",1,,,,,.DGCNT)
S DGSUB=0,DGTEMP=""
F S DGSUB=$O(DGPFF("DESC",DGSUB)) Q:'DGSUB D
. S DGTEMP=$G(DGPFF("DESC",DGSUB,0))
. S DGLINE=DGLINE+1
. D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,,,,,.DGCNT)
;
Q
;
;
HISTDET(DGARY,DGPFFH,DGLINE,DGHISCNT,DGCNT) ;This procedure will build the lines of FLAG HISTORY details in the list area.
;
; Input:
; DGARY - global array subscript
; DGPFFH - flag history array, pass by reference
; DGLINE - line counter
; DGHISCNT - history record counter
;
; Output:
; DGCNT - number of lines in the list, pass by reference
;
;temporary variables used
N DGTEMP
N DGSUB
S DGTEMP=""
;
;set blank line
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
;
;add an additional blank line except on the first history
I DGHISCNT>1 D
. S DGLINE=DGLINE+1
. D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
;
;set history counter
S DGLINE=DGLINE+1
S DGTEMP=DGHISCNT_"."
D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,IORVON,IORVOFF,,,.DGCNT)
;
;set edit date/time
D SET^DGPFLF1(DGARY,DGLINE,"Enter/Edit On: "_$$FDTTM^VALM1($P($G(DGPFFH("ENTERDT")),U)),14,IORVON,IORVOFF,,,.DGCNT)
;
;set entered by
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"Enter/Edit By: "_$P($G(DGPFFH("ENTERBY")),U,2),14,,,,,.DGCNT)
;
;set blank line
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
;
;set edit reason text
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"Reason For Flag Enter/Edit:",1,,,,,.DGCNT)
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"---------------------------",1,,,,,.DGCNT)
I $D(DGPFFH("REASON",1,0)) D
. S DGSUB=0,DGTEMP=""
. F S DGSUB=$O(DGPFFH("REASON",DGSUB)) Q:'DGSUB D
.. S DGTEMP=$G(DGPFFH("REASON",DGSUB,0))
.. S DGLINE=DGLINE+1
.. D SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,,,,,.DGCNT)
E D
. S DGLINE=DGLINE+1
. D SET^DGPFLF1(DGARY,DGLINE,"Unknown",1,,,,,.DGCNT)
;
Q
;
;
HISTHDR(DGARY,DGLINE,DGCNT) ;Set history heading into list area.
;
; Input:
; DGARY - global array subscript
; DGLINE - line counter
;
; Output:
; DGCNT - number of lines in the list, pass by reference
;
;set blank line
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
;
;set hist heading
S DGLINE=DGLINE+1
D SET^DGPFLF1(DGARY,DGLINE,$TR($J("",80)," ","="),1,,,,,.DGCNT)
D SET^DGPFLF1(DGARY,DGLINE,"<Flag Enter/Edit History>",28,IORVON,IORVOFF,,,.DGCNT)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFLFD1 6890 printed Apr 09, 2024@22:01:53 Page 2
DGPFLFD1 ;ALB/KCL - PRF DISPLAY FLAG DETAIL BUILD LIST AREA ; 6/9/04 2:49pm
+1 ;;5.3;Registration;**425,554**;Aug 13, 1993
+2 ;
+3 ;no direct entry
+4 QUIT
+5 ;
EN(DGARY,DGPFIEN,DGCNT) ;Entry point to build flag detail list area.
+1 ;
+2 ; Input:
+3 ; DGARY - global array subscript
+4 ; DGPFIEN - IEN of record in PRF NATIONAL FLAG or PRF LOCAL
+5 ; FLAG file [ex: "1;DGPF(26.15,"]
+6 ;
+7 ; Output:
+8 ; DGCNT - number of lines in the list, pass by reference
+9 ;
+10 ;flag array
NEW DGPFF
+11 ;flag history array
NEW DGPFFH
+12 ;contains flag history ien's
NEW DGFHIENS
+13 ;flag history ien
NEW DGFHIEN
+14 ;history record counter
NEW DGHISCNT
+15 ;line counter
NEW DGLINE
+16 ;subscript of flag history ien's
NEW DGSUB
+17 ;
+18 ;quit if required input paramater not passed
+19 if '$GET(DGPFIEN)
QUIT
+20 ;
+21 ;init variables
+22 SET (DGCNT,DGLINE,DGHISCNT)=0
+23 KILL DGPFF
+24 ;
+25 ;get flag into DGPFF array
+26 if '$$GETFLAG^DGPFUT1(DGPFIEN,.DGPFF)
QUIT
+27 SET DGPFF("PTR")=DGPFIEN
+28 ;
+29 ;build 'Flag Details' list area
+30 DO FLAGDET(DGARY,.DGPFF,.DGLINE,.DGCNT)
+31 ;
+32 ;quit if NATIONAL flag, they don't have a history
+33 if DGPFF("PTR")'["26.11"
QUIT
+34 ;
+35 ;set history heading into list area
+36 DO HISTHDR(DGARY,.DGLINE,.DGCNT)
+37 ;
+38 ;get all history ien's associated with the flag
+39 KILL DGFHIENS
+40 if '$$GETALLDT^DGPFALH(+DGPFF("PTR"),.DGFHIENS)
QUIT
+41 ;
+42 ;reverse loop through each flag history ien
+43 SET DGSUB=9999999.999999
+44 FOR
SET DGSUB=$ORDER(DGFHIENS(DGSUB),-1)
if DGSUB=""
QUIT
Begin DoDot:1
+45 SET DGFHIEN=$GET(DGFHIENS(DGSUB))
+46 KILL DGPFFH
+47 ;- for each ien, get flag history into DGPFFH array
+48 IF $$GETHIST^DGPFALH(DGFHIEN,.DGPFFH)
Begin DoDot:2
+49 ;
+50 ;-- count of history records
+51 SET DGHISCNT=DGHISCNT+1
+52 ;
+53 ;-- build flag history details list area
+54 DO HISTDET(DGARY,.DGPFFH,.DGLINE,DGHISCNT,.DGCNT)
End DoDot:2
End DoDot:1
+55 ;
+56 QUIT
+57 ;
+58 ;
FLAGDET(DGARY,DGPFF,DGLINE,DGCNT) ;This procedure will build the lines of FLAG details in the list area.
+1 ;
+2 ; Input:
+3 ; DGARY - global array subscript
+4 ; DGPFF - flag array, pass by reference
+5 ; DGLINE - line counter
+6 ;
+7 ; Output:
+8 ; DGCNT - number of lines in the list, pass by reference
+9 ;
+10 ;temp vars used
+11 ;array subscript
NEW DGSUB
+12 ;temp text holder
NEW DGTEMP
+13 ;principal investigator count
NEW DGCOUNT
+14 ;
+15 ;set flag name
+16 SET DGLINE=DGLINE+1
+17 DO SET^DGPFLF1(DGARY,DGLINE,"Flag Name: "_$PIECE($GET(DGPFF("FLAG")),U,2),11,,,,,.DGCNT)
+18 ;
+19 ;set flag category
+20 SET DGLINE=DGLINE+1
+21 SET DGTEMP=$SELECT(DGPFF("PTR")["26.11":"II (LOCAL)",DGPFF("PTR")["26.15":"I (NATIONAL)",1:"UNKNOWN")
+22 DO SET^DGPFLF1(DGARY,DGLINE,"Flag Category: "_DGTEMP,7,,,,,.DGCNT)
+23 ;
+24 ;set flag type
+25 SET DGLINE=DGLINE+1
+26 DO SET^DGPFLF1(DGARY,DGLINE,"Flag Type: "_$PIECE($GET(DGPFF("TYPE")),U,2),11,,,,,.DGCNT)
+27 ;
+28 ;set flag status
+29 SET DGLINE=DGLINE+1
+30 DO SET^DGPFLF1(DGARY,DGLINE,"Flag Status: "_$PIECE($GET(DGPFF("STAT")),U,2),9,,,,,.DGCNT)
+31 ;
+32 ;set flag review frequency
+33 SET DGLINE=DGLINE+1
+34 DO SET^DGPFLF1(DGARY,DGLINE,"Review Freq Days: "_$PIECE($GET(DGPFF("REVFREQ")),U,2),4,,,,,.DGCNT)
+35 ;
+36 ;set notification days
+37 SET DGLINE=DGLINE+1
+38 DO SET^DGPFLF1(DGARY,DGLINE,"Notification Days: "_$PIECE($GET(DGPFF("NOTIDAYS")),U,2),3,,,,,.DGCNT)
+39 ;
+40 ;set flag review mail group
+41 SET DGLINE=DGLINE+1
+42 DO SET^DGPFLF1(DGARY,DGLINE,"Review Mail Group: "_$PIECE($GET(DGPFF("REVGRP")),U,2),3,,,,,.DGCNT)
+43 ;
+44 ;set associated progress note title
+45 SET DGLINE=DGLINE+1
+46 DO SET^DGPFLF1(DGARY,DGLINE,"Progress Note Title: "_$EXTRACT($PIECE($GET(DGPFF("TIUTITLE")),U,2),1,59),1,,,,,.DGCNT)
+47 ;
+48 ;set if principal investigator(s)
+49 IF $DATA(DGPFF("PRININV"))
Begin DoDot:1
+50 SET (DGSUB,DGTEMP)=""
+51 SET DGCOUNT=1
+52 FOR
SET DGSUB=$ORDER(DGPFF("PRININV",DGSUB))
if 'DGSUB
QUIT
Begin DoDot:2
+53 if $GET(DGPFF("PRININV",DGSUB,0))="@"
QUIT
+54 IF DGCOUNT=1
Begin DoDot:3
+55 SET DGLINE=DGLINE+1
+56 SET DGTEMP="Principal"
+57 DO SET^DGPFLF1(DGARY,DGLINE,DGTEMP,5,,,,,.DGCNT)
+58 SET DGLINE=DGLINE+1
+59 SET DGTEMP="Investigator(s): "_$PIECE($GET(DGPFF("PRININV",DGSUB,0)),U,2)
+60 DO SET^DGPFLF1(DGARY,DGLINE,DGTEMP,5,,,,,.DGCNT)
End DoDot:3
+61 IF DGCOUNT>1
Begin DoDot:3
+62 SET DGTEMP=$PIECE($GET(DGPFF("PRININV",DGSUB,0)),U,2)
+63 SET DGLINE=DGLINE+1
+64 DO SET^DGPFLF1(DGARY,DGLINE,DGTEMP,22,,,,,.DGCNT)
End DoDot:3
+65 SET DGCOUNT=DGCOUNT+1
End DoDot:2
End DoDot:1
+66 ;
+67 ;set flag description
+68 SET DGLINE=DGLINE+1
+69 DO SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
+70 SET DGLINE=DGLINE+1
+71 DO SET^DGPFLF1(DGARY,DGLINE,"Flag Description:",1,IORVON,IORVOFF,,,.DGCNT)
+72 SET DGLINE=DGLINE+1
+73 DO SET^DGPFLF1(DGARY,DGLINE,"-----------------",1,,,,,.DGCNT)
+74 IF '$DATA(DGPFF("DESC",1,0))
Begin DoDot:1
+75 SET DGLINE=DGLINE+1
+76 DO SET^DGPFLF1(DGARY,DGLINE,"Unknown",1,,,,,.DGCNT)
End DoDot:1
QUIT
+77 SET DGSUB=0
SET DGTEMP=""
+78 FOR
SET DGSUB=$ORDER(DGPFF("DESC",DGSUB))
if 'DGSUB
QUIT
Begin DoDot:1
+79 SET DGTEMP=$GET(DGPFF("DESC",DGSUB,0))
+80 SET DGLINE=DGLINE+1
+81 DO SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,,,,,.DGCNT)
End DoDot:1
+82 ;
+83 QUIT
+84 ;
+85 ;
HISTDET(DGARY,DGPFFH,DGLINE,DGHISCNT,DGCNT) ;This procedure will build the lines of FLAG HISTORY details in the list area.
+1 ;
+2 ; Input:
+3 ; DGARY - global array subscript
+4 ; DGPFFH - flag history array, pass by reference
+5 ; DGLINE - line counter
+6 ; DGHISCNT - history record counter
+7 ;
+8 ; Output:
+9 ; DGCNT - number of lines in the list, pass by reference
+10 ;
+11 ;temporary variables used
+12 NEW DGTEMP
+13 NEW DGSUB
+14 SET DGTEMP=""
+15 ;
+16 ;set blank line
+17 SET DGLINE=DGLINE+1
+18 DO SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
+19 ;
+20 ;add an additional blank line except on the first history
+21 IF DGHISCNT>1
Begin DoDot:1
+22 SET DGLINE=DGLINE+1
+23 DO SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
End DoDot:1
+24 ;
+25 ;set history counter
+26 SET DGLINE=DGLINE+1
+27 SET DGTEMP=DGHISCNT_"."
+28 DO SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,IORVON,IORVOFF,,,.DGCNT)
+29 ;
+30 ;set edit date/time
+31 DO SET^DGPFLF1(DGARY,DGLINE,"Enter/Edit On: "_$$FDTTM^VALM1($PIECE($GET(DGPFFH("ENTERDT")),U)),14,IORVON,IORVOFF,,,.DGCNT)
+32 ;
+33 ;set entered by
+34 SET DGLINE=DGLINE+1
+35 DO SET^DGPFLF1(DGARY,DGLINE,"Enter/Edit By: "_$PIECE($GET(DGPFFH("ENTERBY")),U,2),14,,,,,.DGCNT)
+36 ;
+37 ;set blank line
+38 SET DGLINE=DGLINE+1
+39 DO SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
+40 ;
+41 ;set edit reason text
+42 SET DGLINE=DGLINE+1
+43 DO SET^DGPFLF1(DGARY,DGLINE,"Reason For Flag Enter/Edit:",1,,,,,.DGCNT)
+44 SET DGLINE=DGLINE+1
+45 DO SET^DGPFLF1(DGARY,DGLINE,"---------------------------",1,,,,,.DGCNT)
+46 IF $DATA(DGPFFH("REASON",1,0))
Begin DoDot:1
+47 SET DGSUB=0
SET DGTEMP=""
+48 FOR
SET DGSUB=$ORDER(DGPFFH("REASON",DGSUB))
if 'DGSUB
QUIT
Begin DoDot:2
+49 SET DGTEMP=$GET(DGPFFH("REASON",DGSUB,0))
+50 SET DGLINE=DGLINE+1
+51 DO SET^DGPFLF1(DGARY,DGLINE,DGTEMP,1,,,,,.DGCNT)
End DoDot:2
End DoDot:1
+52 IF '$TEST
Begin DoDot:1
+53 SET DGLINE=DGLINE+1
+54 DO SET^DGPFLF1(DGARY,DGLINE,"Unknown",1,,,,,.DGCNT)
End DoDot:1
+55 ;
+56 QUIT
+57 ;
+58 ;
HISTHDR(DGARY,DGLINE,DGCNT) ;Set history heading into list area.
+1 ;
+2 ; Input:
+3 ; DGARY - global array subscript
+4 ; DGLINE - line counter
+5 ;
+6 ; Output:
+7 ; DGCNT - number of lines in the list, pass by reference
+8 ;
+9 ;set blank line
+10 SET DGLINE=DGLINE+1
+11 DO SET^DGPFLF1(DGARY,DGLINE,"",1,,,,,.DGCNT)
+12 ;
+13 ;set hist heading
+14 SET DGLINE=DGLINE+1
+15 DO SET^DGPFLF1(DGARY,DGLINE,$TRANSLATE($JUSTIFY("",80)," ","="),1,,,,,.DGCNT)
+16 DO SET^DGPFLF1(DGARY,DGLINE,"<Flag Enter/Edit History>",28,IORVON,IORVOFF,,,.DGCNT)
+17 ;
+18 QUIT
