- 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 Feb 19, 2025@00:14:56 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