DGPFUT5 ;ALB/SAE - PRF UTILITIES CONTINUED ; 12/18/03 09:00pm
;;5.3;Registration;**554**;Aug 13, 1993
;
Q ; no direct entry
;
DISPLAY(TXN,DGPFGOUT) ; entry point for user-review screen
;
; This routine completes the re-display process.
; It re-displays information about the Flag, or Flag Assignment,
; being created or modified by the user, prior to the 'file' question.
;
; Input:
; TXN - transaction - has several '^' pieces starting with:
; FA - FLAG ASSIGNMENT - Assign Flag
; FA - FLAG ASSIGNMENT - Edit Flag Assignment
; FA - FLAG ASSIGNMENT - Change Assignment Ownership
; FM - FLAG MANAGEMENT - Add New Record Flag
; FM - FLAG MANAGEMENT - Edit Record Flag
; DGPFGOUT - name of global ^TMP global used to display
;
; Output:
; none - display to user only
;
; Temporary variables:
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ; DIR Reader variables
;
F D I Y=0!$D(DUOUT)!$D(DTOUT) W ! Q
. D DISP(TXN,DGPFGOUT)
. W ! S DIR(0)="Y",DIR("A")="Do you want to review again"
. S DIR("B")="NO" D ^DIR K DIR
;
Q
;
DISP(TXN,DGPFGOUT) ; display user review screen(s):
;
; Re-displays information about the Flag or Flag Assignment being
; created or modified.
;
; Input:
; TXN - transaction - has several pieces starting with:
; FA - FLAG ASSIGNMENT - Assign Flag
; FA - FLAG ASSIGNMENT - Edit Flag Assignment
; FA - FLAG ASSIGNMENT - Change Assignment Ownership
; FM - FLAG MANAGEMENT - Add New Record Flag
; FM - FLAG MANAGEMENT - Edit Record Flag
; DGPFGOUT - name of global ^TMP global used to display
;
; Output:
; none - display to user only
;
; Temporary variables:
N DGPFQUIT ; quit variable for loop
N DGPFCT ; counter variable for loop
N DGPFNEW ; new page indicator
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y ; DIR Reader variables
N DGPFHDR ; used for new screens of word processing displays
N DGPFTHIS ; value of current node
; DGPFTHIS("HEADER") ; this node in global array is a header
N DGPFNEXT ; next node in global array
N DGPFLAST ; prevents page feed and display of headers with no body
N DGPFLINE ; line for underlining headers
N DGPFPINV ; counter to control display of principal investigator label
N DGPFPAD ; pad for leading spaces
N DGPFACT ; ACTION as upper case
;
S DGPFCT=0
S DGPFACT=$TR($P(TXN,U,3),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
S DGPFHDR("TOP")="REVIEW OF "_DGPFACT_" DATA INPUT BEFORE FILING"
;
S DGPFLINE="",$P(DGPFLINE,"-",($L(DGPFHDR("TOP"))+1))=""
S DGPFHDR("TOPLINE")=DGPFLINE
S DGPFPINV=0
;
W:$E(IOST,1,2)="C-" @IOF
W DGPFHDR("TOP"),!,DGPFHDR("TOPLINE")
F S DGPFCT=$O(@DGPFGOUT@(DGPFCT)) Q:DGPFCT="" D Q:$D(DGPFQUIT)
. K DGPFTHIS,DGPFNEXT
. S DGPFTHIS=@DGPFGOUT@(DGPFCT,0)
. S DGPFNEXT=$O(@DGPFGOUT@(DGPFCT))
. S DGPFNEXT=$S(DGPFNEXT="":"",1:@DGPFGOUT@(DGPFNEXT,0))
. S:$O(@DGPFGOUT@(DGPFCT))="" DGPFLAST=1
. ;
. I DGPFTHIS["Principal Investigator(s):" S DGPFPINV=DGPFPINV+1
. I DGPFTHIS["Action Comments:" S DGPFTHIS("HEADER")=1
. I DGPFTHIS["Flag Description:" S DGPFTHIS("HEADER")=1
. I DGPFTHIS["Reason For Flag Enter/Edit:" S DGPFTHIS("HEADER")=1
. I DGPFTHIS["Record Flag Assignment Narrative:" S DGPFTHIS("HEADER")=1
. I DGPFNEXT["Action Comments:" S DGPFNEXT("HEADER")=1
. I DGPFNEXT["Flag Description:" S DGPFNEXT("HEADER")=1
. I DGPFNEXT["Reason For Flag Enter/Edit:" S DGPFNEXT("HEADER")=1
. I DGPFNEXT["Record Flag Assignment Narrative:" S DGPFNEXT("HEADER")=1
. I $D(DGPFTHIS("HEADER")) S DGPFHDR(1)=DGPFTHIS D
. . S DGPFLINE=" ",$P(DGPFLINE,"-",($L(DGPFHDR(1))-1))=""
. ;
. ; if near the bottom, set new screen variable DGPFNEW
. I $Y+9>IOSL I $D(DGPFTHIS("HEADER"))!($Y+6>IOSL) S DGPFNEW=1
. I $D(DGPFNEW),'$D(DGPFLAST) D Q
. . K DGPFNEW W ! S DIR(0)="E" D ^DIR K DIR
. . I $D(DUOUT)!$D(DTOUT) S DGPFQUIT=1 Q
. . W:$E(IOST,1,2)="C-" @IOF
. . W DGPFHDR("TOP"),!,DGPFHDR("TOPLINE")
. . I $D(DGPFHDR(1)) D
. . . I DGPFTHIS?1." ",$D(DGPFNEXT("HEADER")) Q
. . . W !,DGPFHDR(1),!,DGPFLINE
. . W:'$D(DGPFTHIS("HEADER")) !,DGPFTHIS
. . I DGPFTHIS["Principal Investigator(s):" S DGPFPINV=1
. W:$D(DGPFTHIS("HEADER")) !
. ; remove label from Principal Investigator line if not first node
. I DGPFTHIS["Principal Investigator(s):",DGPFPINV>1 D
. . S DGPFPAD=$E($J("",27),1,27)
. . S DGPFTHIS=DGPFPAD_$P(DGPFTHIS,":",2)
. W !,DGPFTHIS
. W:$D(DGPFTHIS("HEADER")) !,DGPFLINE
W !
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFUT5 4566 printed Sep 23, 2025@20:24:46 Page 2
DGPFUT5 ;ALB/SAE - PRF UTILITIES CONTINUED ; 12/18/03 09:00pm
+1 ;;5.3;Registration;**554**;Aug 13, 1993
+2 ;
+3 ; no direct entry
QUIT
+4 ;
DISPLAY(TXN,DGPFGOUT) ; entry point for user-review screen
+1 ;
+2 ; This routine completes the re-display process.
+3 ; It re-displays information about the Flag, or Flag Assignment,
+4 ; being created or modified by the user, prior to the 'file' question.
+5 ;
+6 ; Input:
+7 ; TXN - transaction - has several '^' pieces starting with:
+8 ; FA - FLAG ASSIGNMENT - Assign Flag
+9 ; FA - FLAG ASSIGNMENT - Edit Flag Assignment
+10 ; FA - FLAG ASSIGNMENT - Change Assignment Ownership
+11 ; FM - FLAG MANAGEMENT - Add New Record Flag
+12 ; FM - FLAG MANAGEMENT - Edit Record Flag
+13 ; DGPFGOUT - name of global ^TMP global used to display
+14 ;
+15 ; Output:
+16 ; none - display to user only
+17 ;
+18 ; Temporary variables:
+19 ; DIR Reader variables
NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+20 ;
+21 FOR
Begin DoDot:1
+22 DO DISP(TXN,DGPFGOUT)
+23 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Do you want to review again"
+24 SET DIR("B")="NO"
DO ^DIR
KILL DIR
End DoDot:1
IF Y=0!$DATA(DUOUT)!$DATA(DTOUT)
WRITE !
QUIT
+25 ;
+26 QUIT
+27 ;
DISP(TXN,DGPFGOUT) ; display user review screen(s):
+1 ;
+2 ; Re-displays information about the Flag or Flag Assignment being
+3 ; created or modified.
+4 ;
+5 ; Input:
+6 ; TXN - transaction - has several pieces starting with:
+7 ; FA - FLAG ASSIGNMENT - Assign Flag
+8 ; FA - FLAG ASSIGNMENT - Edit Flag Assignment
+9 ; FA - FLAG ASSIGNMENT - Change Assignment Ownership
+10 ; FM - FLAG MANAGEMENT - Add New Record Flag
+11 ; FM - FLAG MANAGEMENT - Edit Record Flag
+12 ; DGPFGOUT - name of global ^TMP global used to display
+13 ;
+14 ; Output:
+15 ; none - display to user only
+16 ;
+17 ; Temporary variables:
+18 ; quit variable for loop
NEW DGPFQUIT
+19 ; counter variable for loop
NEW DGPFCT
+20 ; new page indicator
NEW DGPFNEW
+21 ; DIR Reader variables
NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+22 ; used for new screens of word processing displays
NEW DGPFHDR
+23 ; value of current node
NEW DGPFTHIS
+24 ; DGPFTHIS("HEADER") ; this node in global array is a header
+25 ; next node in global array
NEW DGPFNEXT
+26 ; prevents page feed and display of headers with no body
NEW DGPFLAST
+27 ; line for underlining headers
NEW DGPFLINE
+28 ; counter to control display of principal investigator label
NEW DGPFPINV
+29 ; pad for leading spaces
NEW DGPFPAD
+30 ; ACTION as upper case
NEW DGPFACT
+31 ;
+32 SET DGPFCT=0
+33 SET DGPFACT=$TRANSLATE($PIECE(TXN,U,3),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+34 SET DGPFHDR("TOP")="REVIEW OF "_DGPFACT_" DATA INPUT BEFORE FILING"
+35 ;
+36 SET DGPFLINE=""
SET $PIECE(DGPFLINE,"-",($LENGTH(DGPFHDR("TOP"))+1))=""
+37 SET DGPFHDR("TOPLINE")=DGPFLINE
+38 SET DGPFPINV=0
+39 ;
+40 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+41 WRITE DGPFHDR("TOP"),!,DGPFHDR("TOPLINE")
+42 FOR
SET DGPFCT=$ORDER(@DGPFGOUT@(DGPFCT))
if DGPFCT=""
QUIT
Begin DoDot:1
+43 KILL DGPFTHIS,DGPFNEXT
+44 SET DGPFTHIS=@DGPFGOUT@(DGPFCT,0)
+45 SET DGPFNEXT=$ORDER(@DGPFGOUT@(DGPFCT))
+46 SET DGPFNEXT=$SELECT(DGPFNEXT="":"",1:@DGPFGOUT@(DGPFNEXT,0))
+47 if $ORDER(@DGPFGOUT@(DGPFCT))=""
SET DGPFLAST=1
+48 ;
+49 IF DGPFTHIS["Principal Investigator(s):"
SET DGPFPINV=DGPFPINV+1
+50 IF DGPFTHIS["Action Comments:"
SET DGPFTHIS("HEADER")=1
+51 IF DGPFTHIS["Flag Description:"
SET DGPFTHIS("HEADER")=1
+52 IF DGPFTHIS["Reason For Flag Enter/Edit:"
SET DGPFTHIS("HEADER")=1
+53 IF DGPFTHIS["Record Flag Assignment Narrative:"
SET DGPFTHIS("HEADER")=1
+54 IF DGPFNEXT["Action Comments:"
SET DGPFNEXT("HEADER")=1
+55 IF DGPFNEXT["Flag Description:"
SET DGPFNEXT("HEADER")=1
+56 IF DGPFNEXT["Reason For Flag Enter/Edit:"
SET DGPFNEXT("HEADER")=1
+57 IF DGPFNEXT["Record Flag Assignment Narrative:"
SET DGPFNEXT("HEADER")=1
+58 IF $DATA(DGPFTHIS("HEADER"))
SET DGPFHDR(1)=DGPFTHIS
Begin DoDot:2
+59 SET DGPFLINE=" "
SET $PIECE(DGPFLINE,"-",($LENGTH(DGPFHDR(1))-1))=""
End DoDot:2
+60 ;
+61 ; if near the bottom, set new screen variable DGPFNEW
+62 IF $Y+9>IOSL
IF $DATA(DGPFTHIS("HEADER"))!($Y+6>IOSL)
SET DGPFNEW=1
+63 IF $DATA(DGPFNEW)
IF '$DATA(DGPFLAST)
Begin DoDot:2
+64 KILL DGPFNEW
WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
+65 IF $DATA(DUOUT)!$DATA(DTOUT)
SET DGPFQUIT=1
QUIT
+66 if $EXTRACT(IOST,1,2)="C-"
WRITE @IOF
+67 WRITE DGPFHDR("TOP"),!,DGPFHDR("TOPLINE")
+68 IF $DATA(DGPFHDR(1))
Begin DoDot:3
+69 IF DGPFTHIS?1." "
IF $DATA(DGPFNEXT("HEADER"))
QUIT
+70 WRITE !,DGPFHDR(1),!,DGPFLINE
End DoDot:3
+71 if '$DATA(DGPFTHIS("HEADER"))
WRITE !,DGPFTHIS
+72 IF DGPFTHIS["Principal Investigator(s):"
SET DGPFPINV=1
End DoDot:2
QUIT
+73 if $DATA(DGPFTHIS("HEADER"))
WRITE !
+74 ; remove label from Principal Investigator line if not first node
+75 IF DGPFTHIS["Principal Investigator(s):"
IF DGPFPINV>1
Begin DoDot:2
+76 SET DGPFPAD=$EXTRACT($JUSTIFY("",27),1,27)
+77 SET DGPFTHIS=DGPFPAD_$PIECE(DGPFTHIS,":",2)
End DoDot:2
+78 WRITE !,DGPFTHIS
+79 if $DATA(DGPFTHIS("HEADER"))
WRITE !,DGPFLINE
End DoDot:1
if $DATA(DGPFQUIT)
QUIT
+80 WRITE !
+81 ;
+82 QUIT
