DGPFLF4 ;ALB/RBS - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS CONT. ; 4/15/04 12:15pm
;;5.3;Registration;**425,554,650**;Aug 13, 1993 ;Build 3
;
;no direct entry
QUIT
;
EF ;Entry point for DGPF EDIT FLAG action protocol.
;
; Input: DGCAT - flag category (1=National, 2=Local)
;
; Output: Edit File entry in PRF LOCAL FLAG FILE (#26.11)
; New File entry in PRF LOCAL FLAG HISTORY FILE (#26.12)
; Set variable VALMBCK to 'R' = refresh screen
;
N X,Y,DIRUT,DTOUT,DUOUT,DIROUT ;input/output vars for ^DIR
N DGIDXIEN ;ien of flag record from the "IDX"
N DGPFLF ;array containing flag record field values
N DGPFLH ;array containing flag history record field values
N DGPFORIG ;save original array containing flag record field values
N DGABORT ;abort flag
N DGRESULT ;result of $$STOALL^DGPFALF1 api call
N DGERR ;if error returned
N DGOK ;ok flag to enter record flag entry & flag description
N DGLOCK ;lock var for flag file edit
N DGSEL ;user selection (list item)
N VALMY ;output of EN^VALM2 call, array of user selected entries
N DGMSG ;user message
N DGQ,DGSUB ;counters and quit flag
;
;init vars
S (DGABORT,DGLOCK,DGRESULT,DGQ,DGSUB)=0
S DGOK=1,(DGSEL,DGIDXIEN)=""
;
;set screen to full scrolling region
D FULL^VALM1
W !
;
;check flag category (only Category II flags can be edited)
I DGCAT=1 D
. D BLD^DIALOG(261129,"Can not edit 'Category I' flags.","","DGERR","F")
. D MSG^DIALOG("WE","","","","DGERR") W *7
. D PAUSE^VALM1
. S DGOK=0
;
;init flag record and history arrays
; The DGPFLF array will contain 2 "^" pieces (internal^external)
; for a final full screen display before filing.
K DGPFLF,DGPFLH,DGPFORIG
;
;allow user to select a single flag for editing
D:DGOK
. S DGOK=0,VALMBCK=""
. D EN^VALM2($G(XQORNOD(0)),"S")
. Q:'$D(VALMY)
. S DGSEL=$O(VALMY(""))
. Q:DGSEL']""
. Q:'$D(@VALMAR@("IDX",DGSEL))
. S DGIDXIEN=$G(@VALMAR@("IDX",DGSEL))
. ; lock flag record
. S DGLOCK=$$LOCKLF^DGPFALF1(DGIDXIEN)
. I 'DGLOCK D Q
. . X DGMSG
. . W !?7,"Unable to Lock Flag, another User is Editing this Flag.",*7
. . D PAUSE^VALM1
. ;
. ; call api to get record back in array DGPFLF
. I '$$GETLF^DGPFALF($P(DGIDXIEN,";"),.DGPFLF) D Q
. . X DGMSG
. . W !?7,"No Local Flag record data found. Please check your selection.",*7
. . D PAUSE^VALM1
. ;
. M DGPFORIG=DGPFLF ;save original array to compare for edits later
. S DGOK=1
;
;Call DGPFLF5 for user prompts to edit fields
; - split from this one due to size
I DGOK D
. D EFCONT^DGPFLF5(.DGPFLF,.DGPFLH,.DGPFORIG,.DGABORT,DGIDXIEN)
. Q:DGABORT
. ;
. ;check to see if user changed anything
. S DGSUB="",DGQ=0
. I $G(DGPFLF("OLDFLAG"))]"" S DGQ=1 ;flag name has changed
. I 'DGQ D
. . F DGSUB="STAT","TYPE","REVFREQ","NOTIDAYS","REVGRP","TIUTITLE" D Q:DGQ
. . . I DGPFLF(DGSUB)'=DGPFORIG(DGSUB) S DGQ=1
. . Q:DGQ
. . ;
. . ;was description modified?
. . I $O(DGPFLF("DESC",""),-1)'=$O(DGPFORIG("DESC",""),-1) S DGQ=1
. . Q:DGQ
. . ;
. . S DGSUB=0
. . F S DGSUB=$O(DGPFLF("DESC",DGSUB)) Q:DGSUB="" D Q:DGQ
. . . I DGPFLF("DESC",DGSUB,0)'=$G(DGPFORIG("DESC",DGSUB,0)) S DGQ=1
. . Q:DGQ
. . ;
. . S DGSUB=0
. . F S DGSUB=$O(DGPFLF("PRININV",DGSUB)) Q:DGSUB="" D Q:DGQ
. . . I DGPFLF("PRININV",DGSUB,0)'=$G(DGPFORIG("PRININV",DGSUB,0)) S DGQ=1
. ;
. I 'DGQ D Q
. . W !!," >>> No edits to "_$P(DGPFLF("FLAG"),U,2)_" were found."
. . S DGABORT=1
. ;
. K DGPFORIG ;kill array - no longer needed
. ;
. ;re-display user's answers on full screen
. D REVIEW^DGPFUT3(.DGPFLF,.DGPFLH,"",XQY0,XQORNOD(0))
. ;
. ;file the edits
. W !,*7
. I $$ANSWER^DGPFUT("Would you like to file the local record flag changes","YES","Y")'>0 S DGABORT=1 Q
. ;
. W !,"Updating the local record flag..."
. ;
. ;setup remaining flag history array nodes for filing
. ;note, the DGPFLH("FLAG") will be setup in $$STOALL^DGPFALF1
. S DGPFLH("ENTERDT")=$$NOW^XLFDT() ;current date/time
. S DGPFLH("ENTERBY")=DUZ ;current user
. ;
. ;file both the (#26.11) & (#26.12) entries
. S DGRESULT=$$STOALL^DGPFALF1(.DGPFLF,.DGPFLH,.DGERR)
. ;
. W !!," >>> Local record flag was "_$S(+DGRESULT:"filed successfully.",1:"not filed successfully."),*7
. ;
. D PAUSE^VALM1
;
I DGLOCK,$$UNLOCK^DGPFALF1(DGIDXIEN)
;
I DGABORT D
. W !!," >>> The '"_$P($G(XQORNOD(0)),U,3)_"' action is aborting, nothing has been filed.",*7
. I $$ANSWER^DGPFUT("Enter RETURN to continue","","E") ;pause
;
;re-build list of local record flags
D BLD^DGPFLF
;
;return to LM (refresh screen)
S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFLF4 4739 printed Sep 23, 2025@20:23:57 Page 2
DGPFLF4 ;ALB/RBS - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS CONT. ; 4/15/04 12:15pm
+1 ;;5.3;Registration;**425,554,650**;Aug 13, 1993 ;Build 3
+2 ;
+3 ;no direct entry
+4 QUIT
+5 ;
EF ;Entry point for DGPF EDIT FLAG action protocol.
+1 ;
+2 ; Input: DGCAT - flag category (1=National, 2=Local)
+3 ;
+4 ; Output: Edit File entry in PRF LOCAL FLAG FILE (#26.11)
+5 ; New File entry in PRF LOCAL FLAG HISTORY FILE (#26.12)
+6 ; Set variable VALMBCK to 'R' = refresh screen
+7 ;
+8 ;input/output vars for ^DIR
NEW X,Y,DIRUT,DTOUT,DUOUT,DIROUT
+9 ;ien of flag record from the "IDX"
NEW DGIDXIEN
+10 ;array containing flag record field values
NEW DGPFLF
+11 ;array containing flag history record field values
NEW DGPFLH
+12 ;save original array containing flag record field values
NEW DGPFORIG
+13 ;abort flag
NEW DGABORT
+14 ;result of $$STOALL^DGPFALF1 api call
NEW DGRESULT
+15 ;if error returned
NEW DGERR
+16 ;ok flag to enter record flag entry & flag description
NEW DGOK
+17 ;lock var for flag file edit
NEW DGLOCK
+18 ;user selection (list item)
NEW DGSEL
+19 ;output of EN^VALM2 call, array of user selected entries
NEW VALMY
+20 ;user message
NEW DGMSG
+21 ;counters and quit flag
NEW DGQ,DGSUB
+22 ;
+23 ;init vars
+24 SET (DGABORT,DGLOCK,DGRESULT,DGQ,DGSUB)=0
+25 SET DGOK=1
SET (DGSEL,DGIDXIEN)=""
+26 ;
+27 ;set screen to full scrolling region
+28 DO FULL^VALM1
+29 WRITE !
+30 ;
+31 ;check flag category (only Category II flags can be edited)
+32 IF DGCAT=1
Begin DoDot:1
+33 DO BLD^DIALOG(261129,"Can not edit 'Category I' flags.","","DGERR","F")
+34 DO MSG^DIALOG("WE","","","","DGERR")
WRITE *7
+35 DO PAUSE^VALM1
+36 SET DGOK=0
End DoDot:1
+37 ;
+38 ;init flag record and history arrays
+39 ; The DGPFLF array will contain 2 "^" pieces (internal^external)
+40 ; for a final full screen display before filing.
+41 KILL DGPFLF,DGPFLH,DGPFORIG
+42 ;
+43 ;allow user to select a single flag for editing
+44 if DGOK
Begin DoDot:1
+45 SET DGOK=0
SET VALMBCK=""
+46 DO EN^VALM2($GET(XQORNOD(0)),"S")
+47 if '$DATA(VALMY)
QUIT
+48 SET DGSEL=$ORDER(VALMY(""))
+49 if DGSEL']""
QUIT
+50 if '$DATA(@VALMAR@("IDX",DGSEL))
QUIT
+51 SET DGIDXIEN=$GET(@VALMAR@("IDX",DGSEL))
+52 ; lock flag record
+53 SET DGLOCK=$$LOCKLF^DGPFALF1(DGIDXIEN)
+54 IF 'DGLOCK
Begin DoDot:2
+55 XECUTE DGMSG
+56 WRITE !?7,"Unable to Lock Flag, another User is Editing this Flag.",*7
+57 DO PAUSE^VALM1
End DoDot:2
QUIT
+58 ;
+59 ; call api to get record back in array DGPFLF
+60 IF '$$GETLF^DGPFALF($PIECE(DGIDXIEN,";"),.DGPFLF)
Begin DoDot:2
+61 XECUTE DGMSG
+62 WRITE !?7,"No Local Flag record data found. Please check your selection.",*7
+63 DO PAUSE^VALM1
End DoDot:2
QUIT
+64 ;
+65 ;save original array to compare for edits later
MERGE DGPFORIG=DGPFLF
+66 SET DGOK=1
End DoDot:1
+67 ;
+68 ;Call DGPFLF5 for user prompts to edit fields
+69 ; - split from this one due to size
+70 IF DGOK
Begin DoDot:1
+71 DO EFCONT^DGPFLF5(.DGPFLF,.DGPFLH,.DGPFORIG,.DGABORT,DGIDXIEN)
+72 if DGABORT
QUIT
+73 ;
+74 ;check to see if user changed anything
+75 SET DGSUB=""
SET DGQ=0
+76 ;flag name has changed
IF $GET(DGPFLF("OLDFLAG"))]""
SET DGQ=1
+77 IF 'DGQ
Begin DoDot:2
+78 FOR DGSUB="STAT","TYPE","REVFREQ","NOTIDAYS","REVGRP","TIUTITLE"
Begin DoDot:3
+79 IF DGPFLF(DGSUB)'=DGPFORIG(DGSUB)
SET DGQ=1
End DoDot:3
if DGQ
QUIT
+80 if DGQ
QUIT
+81 ;
+82 ;was description modified?
+83 IF $ORDER(DGPFLF("DESC",""),-1)'=$ORDER(DGPFORIG("DESC",""),-1)
SET DGQ=1
+84 if DGQ
QUIT
+85 ;
+86 SET DGSUB=0
+87 FOR
SET DGSUB=$ORDER(DGPFLF("DESC",DGSUB))
if DGSUB=""
QUIT
Begin DoDot:3
+88 IF DGPFLF("DESC",DGSUB,0)'=$GET(DGPFORIG("DESC",DGSUB,0))
SET DGQ=1
End DoDot:3
if DGQ
QUIT
+89 if DGQ
QUIT
+90 ;
+91 SET DGSUB=0
+92 FOR
SET DGSUB=$ORDER(DGPFLF("PRININV",DGSUB))
if DGSUB=""
QUIT
Begin DoDot:3
+93 IF DGPFLF("PRININV",DGSUB,0)'=$GET(DGPFORIG("PRININV",DGSUB,0))
SET DGQ=1
End DoDot:3
if DGQ
QUIT
End DoDot:2
+94 ;
+95 IF 'DGQ
Begin DoDot:2
+96 WRITE !!," >>> No edits to "_$PIECE(DGPFLF("FLAG"),U,2)_" were found."
+97 SET DGABORT=1
End DoDot:2
QUIT
+98 ;
+99 ;kill array - no longer needed
KILL DGPFORIG
+100 ;
+101 ;re-display user's answers on full screen
+102 DO REVIEW^DGPFUT3(.DGPFLF,.DGPFLH,"",XQY0,XQORNOD(0))
+103 ;
+104 ;file the edits
+105 WRITE !,*7
+106 IF $$ANSWER^DGPFUT("Would you like to file the local record flag changes","YES","Y")'>0
SET DGABORT=1
QUIT
+107 ;
+108 WRITE !,"Updating the local record flag..."
+109 ;
+110 ;setup remaining flag history array nodes for filing
+111 ;note, the DGPFLH("FLAG") will be setup in $$STOALL^DGPFALF1
+112 ;current date/time
SET DGPFLH("ENTERDT")=$$NOW^XLFDT()
+113 ;current user
SET DGPFLH("ENTERBY")=DUZ
+114 ;
+115 ;file both the (#26.11) & (#26.12) entries
+116 SET DGRESULT=$$STOALL^DGPFALF1(.DGPFLF,.DGPFLH,.DGERR)
+117 ;
+118 WRITE !!," >>> Local record flag was "_$SELECT(+DGRESULT:"filed successfully.",1:"not filed successfully."),*7
+119 ;
+120 DO PAUSE^VALM1
End DoDot:1
+121 ;
+122 IF DGLOCK
IF $$UNLOCK^DGPFALF1(DGIDXIEN)
+123 ;
+124 IF DGABORT
Begin DoDot:1
+125 WRITE !!," >>> The '"_$PIECE($GET(XQORNOD(0)),U,3)_"' action is aborting, nothing has been filed.",*7
+126 ;pause
IF $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
End DoDot:1
+127 ;
+128 ;re-build list of local record flags
+129 DO BLD^DGPFLF
+130 ;
+131 ;return to LM (refresh screen)
+132 SET VALMBCK="R"
+133 QUIT
+134 ;
