DGPFLF5 ;ALB/RBS - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS CONT. ; 3/23/05 1:01pm
;;5.3;Registration;**425,554**;Aug 13, 1993
;
;no direct entry
QUIT
;
EFCONT(DGPFLF,DGPFLH,DGPFORIG,DGABORT,DGIDXIEN) ; EF Edit Flag action
;-- Continue entry point for DGPF EDIT FLAG action protocol.
;
; Input:
; DGPFLF - array of flag record fields (passed by reference)
; DGPFLH - array for REASON field (passed by reference)
; DGPFORIG - DGPFLF copy of original values (passed by reference)
; DGABORT - abort flag - value passed in = 0
; DGIDXIEN - ien of flag record from the "IDX"
;
; Output:
; DGPFLF - Edited array of flag record fields
; DGABORT - 1 if user wishes to abort, 0 otherwise
;
N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK ;input vars for EN^DIWE call
N DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT ;input/output vars for ^DIR
N DGDA ;default answer
N DGCKWP ;check if word-processing is OK
N DGASK ;return value from $$ANSWER^DGPFUT call
N DGRDAY ;review frequency
N DGQ,DGSUB ;counters and quit flag
N DGACNT ;count of existing assignments assigned to flag
N DGDFNLST ;array of DFN's when existing assignments are found
N DGTITLE ;pointer of the progress note title
N DGARRAY ;array of assignment history data
;
S (DGACNT,DGQ,DGSUB)=0
S DGARRAY=$NA(^TMP("DGPFLF5",$J)) K @DGARRAY
;
; check for assignments to the flag and load the array with the DFN's
S DGACNT=$$ASGNCNT^DGPFLF6(DGIDXIEN,.DGDFNLST)
I DGACNT M @DGARRAY=DGDFNLST K DGDFNLST
;
;-- user prompts
D
. ;-- prompt for flag name, quit if one not entered
. S DGDA=$P($G(DGPFLF("FLAG")),U,2)
. S DGASK=$$ANSWER^DGPFUT("Enter the Record Flag Name",DGDA,"26.11,.01^^I X'=DGDA,$D(^DGPF(26.11,""B"",X)) K X W "" *** Flag name already on file""")
. I DGASK=-1!(DGASK=0) S DGABORT=1 Q
. I DGASK'=DGDA D
. . I DGACNT D Q
. . . W !," >>> Name change not allowed ... "_DGACNT_" patients are assigned to this flag."
. . . S DGABORT=1
. . ;
. . S DGPFLF("OLDFLAG")=DGDA ;save for name change lookup
. . S DGPFLF("FLAG")=DGASK_U_DGASK
. ;
. Q:DGABORT
. ;
. ;-- prompt for status of the flag, quit if one not entered
. S DGDA=$P($G(DGPFLF("STAT")),U,2)
. S DGASK=$$ANSWER^DGPFUT("Enter the Status of the Flag",DGDA,"26.11,.02")
. I DGASK<0 S DGABORT=1 Q
. S:DGASK'=$P($G(DGPFLF("STAT")),U) DGPFLF("STAT")=DGASK_U_$$EXTERNAL^DILFD(26.11,.02,"F",DGASK)
. ;
. ; check for any Active Patient Assignments and give warning
. ; that all patients will be inactivated when this edit is filed
. I DGASK=0,$D(^DGPF(26.13,"ASTAT",1,DGIDXIEN)) D
. . W *7,!," >>> WARNING - All Patient's assigned to this flag will be"
. . W !?17,"Inactivated automatically after filing this edit."
. . ;
. . I $$ANSWER^DGPFUT("Enter RETURN to continue or '^' to exit","","E")=-1 S DGABORT=1
. ;
. Q:DGABORT
. ;
. ;-- prompt for flag type, quit if one not entered
. S DGDA=$P($G(DGPFLF("TYPE")),U,2)
. S DGASK=$$ANSWER^DGPFUT("Enter the Type of the Flag",DGDA,"26.11,.03")
. I DGASK'>0 S DGABORT=1 Q
. I DGASK'=$P($G(DGPFLF("TYPE")),U) D
. . I DGACNT D Q
. . . W !," >>> Flag Type change not allowed ... "_DGACNT_" patients are assigned to this flag."
. . . S DGABORT=1
. . S DGPFLF("TYPE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.03,"F",DGASK)
. Q:DGABORT
. ;
. ;-- delete all principal investigator(s) if flag type not RESEARCH
. I +DGPFLF("TYPE")'=2,$D(DGPFLF("PRININV")) D
. . S DGSUB=0
. . F S DGSUB=$O(DGPFLF("PRININV",DGSUB)) Q:DGSUB="" D
. . . S DGPFLF("PRININV",DGSUB,0)="@"
. ;
. ;-- prompt for principal investigator(s) name for RESEARCH type flag
. I +DGPFLF("TYPE")=2,'$$PRININV^DGPFLF6(+DGIDXIEN,.DGPFLF) D Q:DGABORT
. . I $$ANSWER^DGPFUT("Enter RETURN to continue or '^' to exit","","E")=-1 S DGABORT=1
. ;
. ;-- prompt for review frequency, quit if one not entered
. S DGDA=$P($G(DGPFLF("REVFREQ")),U,2)
. S DGASK=$$ANSWER^DGPFUT("Enter the Review Frequency Days",DGDA,"26.11,.04^^K:$L(X)>4!(X[""."") X")
. I DGASK<0 S DGABORT=1 Q
. S:DGASK'=$P($G(DGPFLF("REVFREQ")),U) DGPFLF("REVFREQ")=DGASK_U_DGASK
. S DGRDAY=DGASK
. I DGASK=0 D ;don't ask notification/review group when review freq = 0
. . S DGPFLF("NOTIDAYS")=0_U_0
. . S DGPFLF("REVGRP")=""_U_""
. . ;
. E D Q:DGABORT
. . ;
. . ;-- prompt for notification days
. . S DGDA=$P($G(DGPFLF("NOTIDAYS")),U,2)
. . S DGASK=$$ANSWER^DGPFUT("Enter the Notification Days",DGDA,"26.11,.05^^K:$L(X)>4!(X[""."")!(X>DGRDAY) X")
. . I DGASK<0 S DGABORT=1 Q
. . S DGPFLF("NOTIDAYS")=DGASK_U_DGASK
. . ;
. . S DGQ=0
. . F D Q:(DGQ!DGABORT)
. . . ;-- prompt for review mail group name, optional entry
. . . S DGDA=$P($G(DGPFLF("REVGRP")),U,2)
. . . S DGASK=$$ANSWER^DGPFUT("Enter the Review Mail Group",DGDA,"26.11,.06r")
. . . I DGASK<0 S DGABORT=1 Q
. . . I DGASK'>0 D Q
. . . . W !," >>> You've entered the Review Frequency and Notification Days,"
. . . . W !," now enter a Review Mail Group or abort this process.",*7
. . . . I '$$CONTINUE^DGPFUT() S DGABORT=1
. . . ;
. . . S DGPFLF("REVGRP")=DGASK_U_$$EXTERNAL^DILFD(26.11,.06,"F",DGASK)
. . . S DGQ=1 ;set entry, quit
. ;
. ;-- prompt for associated TIU PN Title
. S DGDA=$P($G(DGPFLF("TIUTITLE")),U,2),DGQ=0
. S DGTITLE=$P($G(DGPFLF("TIUTITLE")),U)
. S DGASK=$$ANSWER^DGPFUT("Enter the Progress Note Title",DGDA,"26.11,.07r")
. I DGASK<0 S DGABORT=1 Q
. ;
. ; Do not allow the title to change using the following logic:
. ; - if the existing progress note title changes,
. ; and there are patients assigned to the record flag name,
. ; and there are any linked TIU progress notes on any patients
. ; assignment history record
. ;
. I DGASK'=DGTITLE D
. . I $$FNDTITLE^DGPFAPI1(DGASK) S DGQ=1 ;should never happen...but
. . I 'DGQ,DGTITLE,DGACNT D
. . . ; check all DFN's assigned to the record flag
. . . I $$CKTIUPN^DGPFLF6(DGTITLE,DGARRAY) S DGQ=1
. . I DGQ D Q
. . . W !!," >>> Unable to edit, there are Progress Note(s) associated with a",!," patient's PRF Assignment action.",!,*7
. . ;
. . ; ok to add or change the TIU Progress Note Title
. . S DGPFLF("TIUTITLE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.07,"F",DGASK)
. ;
. Q:DGABORT
. ;
. ;-- ask user if they want to edit the flag description text
. I $$ANSWER^DGPFUT("Would you like to edit the description of this record flag","NO","Y")>0 D Q:DGABORT
. . S DGCKWP=0 K DGERR
. . S DGWPROOT=$NA(^TMP($J,"DGPFDESC"))
. . K @DGWPROOT
. . S DGDA=$$GET1^DIQ(26.11,$P(DGIDXIEN,";"),"1","Z",DGWPROOT,"DGERR")
. . I $D(DGERR)!(DGDA="") S DGABORT=1 D Q
. . . W !,"An error has occurred while trying to retrieve the Flag Description Text.",*7
. . F D Q:(DGCKWP!DGABORT)
. . . S DIC=$$OREF^DILF(DGWPROOT)
. . . S DIWETXT="Patient Record Flag - Flag Description Text"
. . . S DIWESUB="Flag Description Text"
. . . S DWLW=75 ;max # chars allowed to be stored on WP global node
. . . S DWPK=1 ;if line editor, don't join line
. . . D EN^DIWE
. . . I $$CKWP^DGPFUT(DGWPROOT) S DGCKWP=1 Q
. . . W !,"Flag Description Text is required!",!,*7
. . . I '$$CONTINUE^DGPFUT() S DGABORT=1 K @DGWPROOT
. . ;
. . ;-- quit if required flag description not entered
. . Q:DGABORT
. . ;
. . ;-- place flag description text into assignment array
. . I DGCKWP D
. . . K DGPFLF("DESC")
. . . M DGPFLF("DESC")=@DGWPROOT
. . . K @DGWPROOT
. ;
. Q:DGABORT
. ;
. ;-- have user enter edit reason (required)
. S DGCKWP=0
. S DGWPROOT=$NA(^TMP($J,"DGPFREASON"))
. K @DGWPROOT
. F D Q:(DGCKWP!DGABORT)
. . W !!,"Enter the reason for editing this record flag:" ;needed for line editor
. . S DIC=$$OREF^DILF(DGWPROOT)
. . S DIWETXT="Patient Record Flag - Edit Reason Text"
. . S DIWESUB="Edit Reason Text"
. . S DWLW=75 ;max # chars allowed to be stored on WP global node
. . S DWPK=1 ;if line editor, don't join line
. . D EN^DIWE
. . I $$CKWP^DGPFUT(DGWPROOT) S DGCKWP=1 Q
. . W !,"Edit Reason Text is required!",!,*7
. . I '$$CONTINUE^DGPFUT() S DGABORT=1 K @DGWPROOT
. ;
. Q:DGABORT
. I DGCKWP M DGPFLH("REASON")=@DGWPROOT K @DGWPROOT
. ;
. S:'DGCKWP DGABORT=1
;
I DGACNT K @DGARRAY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFLF5 8345 printed Nov 22, 2024@17:58:05 Page 2
DGPFLF5 ;ALB/RBS - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS CONT. ; 3/23/05 1:01pm
+1 ;;5.3;Registration;**425,554**;Aug 13, 1993
+2 ;
+3 ;no direct entry
+4 QUIT
+5 ;
EFCONT(DGPFLF,DGPFLH,DGPFORIG,DGABORT,DGIDXIEN) ; EF Edit Flag action
+1 ;-- Continue entry point for DGPF EDIT FLAG action protocol.
+2 ;
+3 ; Input:
+4 ; DGPFLF - array of flag record fields (passed by reference)
+5 ; DGPFLH - array for REASON field (passed by reference)
+6 ; DGPFORIG - DGPFLF copy of original values (passed by reference)
+7 ; DGABORT - abort flag - value passed in = 0
+8 ; DGIDXIEN - ien of flag record from the "IDX"
+9 ;
+10 ; Output:
+11 ; DGPFLF - Edited array of flag record fields
+12 ; DGABORT - 1 if user wishes to abort, 0 otherwise
+13 ;
+14 ;input vars for EN^DIWE call
NEW DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK
+15 ;input/output vars for ^DIR
NEW DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
+16 ;default answer
NEW DGDA
+17 ;check if word-processing is OK
NEW DGCKWP
+18 ;return value from $$ANSWER^DGPFUT call
NEW DGASK
+19 ;review frequency
NEW DGRDAY
+20 ;counters and quit flag
NEW DGQ,DGSUB
+21 ;count of existing assignments assigned to flag
NEW DGACNT
+22 ;array of DFN's when existing assignments are found
NEW DGDFNLST
+23 ;pointer of the progress note title
NEW DGTITLE
+24 ;array of assignment history data
NEW DGARRAY
+25 ;
+26 SET (DGACNT,DGQ,DGSUB)=0
+27 SET DGARRAY=$NAME(^TMP("DGPFLF5",$JOB))
KILL @DGARRAY
+28 ;
+29 ; check for assignments to the flag and load the array with the DFN's
+30 SET DGACNT=$$ASGNCNT^DGPFLF6(DGIDXIEN,.DGDFNLST)
+31 IF DGACNT
MERGE @DGARRAY=DGDFNLST
KILL DGDFNLST
+32 ;
+33 ;-- user prompts
+34 Begin DoDot:1
+35 ;-- prompt for flag name, quit if one not entered
+36 SET DGDA=$PIECE($GET(DGPFLF("FLAG")),U,2)
+37 SET DGASK=$$ANSWER^DGPFUT("Enter the Record Flag Name",DGDA,"26.11,.01^^I X'=DGDA,$D(^DGPF(26.11,""B"",X)) K X W "" *** Flag name already on file""")
+38 IF DGASK=-1!(DGASK=0)
SET DGABORT=1
QUIT
+39 IF DGASK'=DGDA
Begin DoDot:2
+40 IF DGACNT
Begin DoDot:3
+41 WRITE !," >>> Name change not allowed ... "_DGACNT_" patients are assigned to this flag."
+42 SET DGABORT=1
End DoDot:3
QUIT
+43 ;
+44 ;save for name change lookup
SET DGPFLF("OLDFLAG")=DGDA
+45 SET DGPFLF("FLAG")=DGASK_U_DGASK
End DoDot:2
+46 ;
+47 if DGABORT
QUIT
+48 ;
+49 ;-- prompt for status of the flag, quit if one not entered
+50 SET DGDA=$PIECE($GET(DGPFLF("STAT")),U,2)
+51 SET DGASK=$$ANSWER^DGPFUT("Enter the Status of the Flag",DGDA,"26.11,.02")
+52 IF DGASK<0
SET DGABORT=1
QUIT
+53 if DGASK'=$PIECE($GET(DGPFLF("STAT")),U)
SET DGPFLF("STAT")=DGASK_U_$$EXTERNAL^DILFD(26.11,.02,"F",DGASK)
+54 ;
+55 ; check for any Active Patient Assignments and give warning
+56 ; that all patients will be inactivated when this edit is filed
+57 IF DGASK=0
IF $DATA(^DGPF(26.13,"ASTAT",1,DGIDXIEN))
Begin DoDot:2
+58 WRITE *7,!," >>> WARNING - All Patient's assigned to this flag will be"
+59 WRITE !?17,"Inactivated automatically after filing this edit."
+60 ;
+61 IF $$ANSWER^DGPFUT("Enter RETURN to continue or '^' to exit","","E")=-1
SET DGABORT=1
End DoDot:2
+62 ;
+63 if DGABORT
QUIT
+64 ;
+65 ;-- prompt for flag type, quit if one not entered
+66 SET DGDA=$PIECE($GET(DGPFLF("TYPE")),U,2)
+67 SET DGASK=$$ANSWER^DGPFUT("Enter the Type of the Flag",DGDA,"26.11,.03")
+68 IF DGASK'>0
SET DGABORT=1
QUIT
+69 IF DGASK'=$PIECE($GET(DGPFLF("TYPE")),U)
Begin DoDot:2
+70 IF DGACNT
Begin DoDot:3
+71 WRITE !," >>> Flag Type change not allowed ... "_DGACNT_" patients are assigned to this flag."
+72 SET DGABORT=1
End DoDot:3
QUIT
+73 SET DGPFLF("TYPE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.03,"F",DGASK)
End DoDot:2
+74 if DGABORT
QUIT
+75 ;
+76 ;-- delete all principal investigator(s) if flag type not RESEARCH
+77 IF +DGPFLF("TYPE")'=2
IF $DATA(DGPFLF("PRININV"))
Begin DoDot:2
+78 SET DGSUB=0
+79 FOR
SET DGSUB=$ORDER(DGPFLF("PRININV",DGSUB))
if DGSUB=""
QUIT
Begin DoDot:3
+80 SET DGPFLF("PRININV",DGSUB,0)="@"
End DoDot:3
End DoDot:2
+81 ;
+82 ;-- prompt for principal investigator(s) name for RESEARCH type flag
+83 IF +DGPFLF("TYPE")=2
IF '$$PRININV^DGPFLF6(+DGIDXIEN,.DGPFLF)
Begin DoDot:2
+84 IF $$ANSWER^DGPFUT("Enter RETURN to continue or '^' to exit","","E")=-1
SET DGABORT=1
End DoDot:2
if DGABORT
QUIT
+85 ;
+86 ;-- prompt for review frequency, quit if one not entered
+87 SET DGDA=$PIECE($GET(DGPFLF("REVFREQ")),U,2)
+88 SET DGASK=$$ANSWER^DGPFUT("Enter the Review Frequency Days",DGDA,"26.11,.04^^K:$L(X)>4!(X[""."") X")
+89 IF DGASK<0
SET DGABORT=1
QUIT
+90 if DGASK'=$PIECE($GET(DGPFLF("REVFREQ")),U)
SET DGPFLF("REVFREQ")=DGASK_U_DGASK
+91 SET DGRDAY=DGASK
+92 ;don't ask notification/review group when review freq = 0
IF DGASK=0
Begin DoDot:2
+93 SET DGPFLF("NOTIDAYS")=0_U_0
+94 SET DGPFLF("REVGRP")=""_U_""
+95 ;
End DoDot:2
+96 IF '$TEST
Begin DoDot:2
+97 ;
+98 ;-- prompt for notification days
+99 SET DGDA=$PIECE($GET(DGPFLF("NOTIDAYS")),U,2)
+100 SET DGASK=$$ANSWER^DGPFUT("Enter the Notification Days",DGDA,"26.11,.05^^K:$L(X)>4!(X[""."")!(X>DGRDAY) X")
+101 IF DGASK<0
SET DGABORT=1
QUIT
+102 SET DGPFLF("NOTIDAYS")=DGASK_U_DGASK
+103 ;
+104 SET DGQ=0
+105 FOR
Begin DoDot:3
+106 ;-- prompt for review mail group name, optional entry
+107 SET DGDA=$PIECE($GET(DGPFLF("REVGRP")),U,2)
+108 SET DGASK=$$ANSWER^DGPFUT("Enter the Review Mail Group",DGDA,"26.11,.06r")
+109 IF DGASK<0
SET DGABORT=1
QUIT
+110 IF DGASK'>0
Begin DoDot:4
+111 WRITE !," >>> You've entered the Review Frequency and Notification Days,"
+112 WRITE !," now enter a Review Mail Group or abort this process.",*7
+113 IF '$$CONTINUE^DGPFUT()
SET DGABORT=1
End DoDot:4
QUIT
+114 ;
+115 SET DGPFLF("REVGRP")=DGASK_U_$$EXTERNAL^DILFD(26.11,.06,"F",DGASK)
+116 ;set entry, quit
SET DGQ=1
End DoDot:3
if (DGQ!DGABORT)
QUIT
End DoDot:2
if DGABORT
QUIT
+117 ;
+118 ;-- prompt for associated TIU PN Title
+119 SET DGDA=$PIECE($GET(DGPFLF("TIUTITLE")),U,2)
SET DGQ=0
+120 SET DGTITLE=$PIECE($GET(DGPFLF("TIUTITLE")),U)
+121 SET DGASK=$$ANSWER^DGPFUT("Enter the Progress Note Title",DGDA,"26.11,.07r")
+122 IF DGASK<0
SET DGABORT=1
QUIT
+123 ;
+124 ; Do not allow the title to change using the following logic:
+125 ; - if the existing progress note title changes,
+126 ; and there are patients assigned to the record flag name,
+127 ; and there are any linked TIU progress notes on any patients
+128 ; assignment history record
+129 ;
+130 IF DGASK'=DGTITLE
Begin DoDot:2
+131 ;should never happen...but
IF $$FNDTITLE^DGPFAPI1(DGASK)
SET DGQ=1
+132 IF 'DGQ
IF DGTITLE
IF DGACNT
Begin DoDot:3
+133 ; check all DFN's assigned to the record flag
+134 IF $$CKTIUPN^DGPFLF6(DGTITLE,DGARRAY)
SET DGQ=1
End DoDot:3
+135 IF DGQ
Begin DoDot:3
+136 WRITE !!," >>> Unable to edit, there are Progress Note(s) associated with a",!," patient's PRF Assignment action.",!,*7
End DoDot:3
QUIT
+137 ;
+138 ; ok to add or change the TIU Progress Note Title
+139 SET DGPFLF("TIUTITLE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.07,"F",DGASK)
End DoDot:2
+140 ;
+141 if DGABORT
QUIT
+142 ;
+143 ;-- ask user if they want to edit the flag description text
+144 IF $$ANSWER^DGPFUT("Would you like to edit the description of this record flag","NO","Y")>0
Begin DoDot:2
+145 SET DGCKWP=0
KILL DGERR
+146 SET DGWPROOT=$NAME(^TMP($JOB,"DGPFDESC"))
+147 KILL @DGWPROOT
+148 SET DGDA=$$GET1^DIQ(26.11,$PIECE(DGIDXIEN,";"),"1","Z",DGWPROOT,"DGERR")
+149 IF $DATA(DGERR)!(DGDA="")
SET DGABORT=1
Begin DoDot:3
+150 WRITE !,"An error has occurred while trying to retrieve the Flag Description Text.",*7
End DoDot:3
QUIT
+151 FOR
Begin DoDot:3
+152 SET DIC=$$OREF^DILF(DGWPROOT)
+153 SET DIWETXT="Patient Record Flag - Flag Description Text"
+154 SET DIWESUB="Flag Description Text"
+155 ;max # chars allowed to be stored on WP global node
SET DWLW=75
+156 ;if line editor, don't join line
SET DWPK=1
+157 DO EN^DIWE
+158 IF $$CKWP^DGPFUT(DGWPROOT)
SET DGCKWP=1
QUIT
+159 WRITE !,"Flag Description Text is required!",!,*7
+160 IF '$$CONTINUE^DGPFUT()
SET DGABORT=1
KILL @DGWPROOT
End DoDot:3
if (DGCKWP!DGABORT)
QUIT
+161 ;
+162 ;-- quit if required flag description not entered
+163 if DGABORT
QUIT
+164 ;
+165 ;-- place flag description text into assignment array
+166 IF DGCKWP
Begin DoDot:3
+167 KILL DGPFLF("DESC")
+168 MERGE DGPFLF("DESC")=@DGWPROOT
+169 KILL @DGWPROOT
End DoDot:3
End DoDot:2
if DGABORT
QUIT
+170 ;
+171 if DGABORT
QUIT
+172 ;
+173 ;-- have user enter edit reason (required)
+174 SET DGCKWP=0
+175 SET DGWPROOT=$NAME(^TMP($JOB,"DGPFREASON"))
+176 KILL @DGWPROOT
+177 FOR
Begin DoDot:2
+178 ;needed for line editor
WRITE !!,"Enter the reason for editing this record flag:"
+179 SET DIC=$$OREF^DILF(DGWPROOT)
+180 SET DIWETXT="Patient Record Flag - Edit Reason Text"
+181 SET DIWESUB="Edit Reason Text"
+182 ;max # chars allowed to be stored on WP global node
SET DWLW=75
+183 ;if line editor, don't join line
SET DWPK=1
+184 DO EN^DIWE
+185 IF $$CKWP^DGPFUT(DGWPROOT)
SET DGCKWP=1
QUIT
+186 WRITE !,"Edit Reason Text is required!",!,*7
+187 IF '$$CONTINUE^DGPFUT()
SET DGABORT=1
KILL @DGWPROOT
End DoDot:2
if (DGCKWP!DGABORT)
QUIT
+188 ;
+189 if DGABORT
QUIT
+190 IF DGCKWP
MERGE DGPFLH("REASON")=@DGWPROOT
KILL @DGWPROOT
+191 ;
+192 if 'DGCKWP
SET DGABORT=1
End DoDot:1
+193 ;
+194 IF DGACNT
KILL @DGARRAY
+195 QUIT
