DGPFLF3 ;ALB/RBS - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS CONT. ; 6/9/04 2:05pm
;;5.3;Registration;**425,554,650**;Aug 13, 1993 ;Build 3
;
;no direct entry
QUIT
;
;
AF ;Entry point for DGPF ADD FLAG action protocol.
;
; Input: DGCAT - flag category (1=National, 2=Local)
;
; Output: New 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 DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK ;input vars for EN^DIWE call
N DGASK ;return value from call to ^DIR - $$ANSWER^DGPFUT call
N DGCKWP ;check if word-processing is OK
N DGPFLF ;array containing flag record field values
N DGPFLH ;array containing flag history record field values
N DGABORT ;abort flag
N DGRESULT ;result of $$STOALL^DGPFALF1 api call
N DGRDAY ;review frequency var
N DGNDAY ;notification days var
N DGERR ;if error returned
N DGOK ;ok flag to enter record flag entry & flag description
N DGMSG ;user message
N DGQ ;quit flag
;
;init vars
S DGOK=1,(DGQ,DGABORT)=0
;
;set screen to full scrolling region
D FULL^VALM1
W !
;
;check flag category (only Category II flags can be created)
I DGCAT=1 D
. D BLD^DIALOG(261129,"Can not add 'Category I' flags.","","DGERR","F")
. D MSG^DIALOG("WE","","","","DGERR") W *7
. D PAUSE^VALM1
. S DGOK=0
;
;user prompts
D:DGOK
. ;-- 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
. ;
. ;-- prompt for flag name, quit if one not entered
. S DGASK=$$ANSWER^DGPFUT("Enter the Record Flag Name","","26.11,.01^^I $D(^DGPF(26.11,""B"",X)) K X W "" *** Flag name already on file""")
. I DGASK=-1!(DGASK=0) S DGABORT=1 Q
. S DGPFLF("FLAG")=DGASK_U_DGASK
. ;
. ;-- prompt for status of the flag, quit if one not entered
. S DGASK=$$ANSWER^DGPFUT("Enter the Status of the Flag","ACTIVE","26.11,.02")
. I DGASK<0 S DGABORT=1 Q
. S DGPFLF("STAT")=DGASK_U_$$EXTERNAL^DILFD(26.11,.02,"F",DGASK)
. ;
. ;-- prompt for flag type, quit if one not entered
. S DGASK=$$ANSWER^DGPFUT("Enter the Type of the Flag","","26.11,.03")
. I DGASK'>0 S DGABORT=1 Q
. S DGPFLF("TYPE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.03,"F",DGASK)
. ;
. ;-- prompt for principal investigator(s) name for RESEARCH flag type
. I +DGPFLF("TYPE")=2,'$$PRININV^DGPFLF6(0,.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 user aborts
. S DGASK=$$ANSWER^DGPFUT("Enter the Review Frequency Days","","26.11,.04^^K:$L(X)>4!(X[""."") X")
. I DGASK<0 S DGABORT=1 Q
. S DGPFLF("REVFREQ")=DGASK_U_DGASK
. S DGRDAY=DGASK
. I DGASK=0 D
. . ;-- if review frequency=0, don't ask notification/review group
. . ; reset both fields
. . S DGPFLF("NOTIDAYS")=0_U_0
. . S DGPFLF("REVGRP")=""_U_""
. . ;
. E D Q:DGABORT ;continue to prompt user and check abort logic
. . ;
. . ;-- prompt for notification days
. . S DGASK=$$ANSWER^DGPFUT("Enter the Notification Days","","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 DGASK=$$ANSWER^DGPFUT("Enter the Review Mail Group","","26.11,.06")
. . . 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, quit if one not entered
. ; There is a DD screen on the (#.07) field - using IA #4380
. ; to only display Category II PN Titles not already associated
. ; with a Category II (Local) Record Flag name.
. ;
. S DGASK=$$ANSWER^DGPFUT("Enter the Progress Note Title","","26.11,.07")
. I DGASK<0 S DGABORT=1 Q
. S DGPFLF("TIUTITLE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.07,"F",DGASK)
. ;
. ;-- have user enter flag description text (required)
. S DGCKWP=0
. S DGWPROOT=$NA(^TMP($J,"DGPFDESC"))
. K @DGWPROOT
. F D Q:(DGCKWP!DGABORT)
. . W !,"Enter the description for this new record flag:" ;needed for line editor
. . S DIC=$$OREF^DILF(DGWPROOT)
. . S DIWETXT="Patient Record Flag - Flag Description Text"
. . S DIWESUB="Flag Description Text"
. . S DWLW=75 ;max # of 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
. ;
. ;-- quit if required flag description not entered
. Q:DGABORT
. ;
. ;-- place flag description text into assignment array
. M DGPFLF("DESC")=@DGWPROOT K @DGWPROOT
. ;
. ;-- 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
. S DGPFLH("REASON",1,0)="New Local Patient Record Flag entered."
. ;
. ;-- re-display user's answers on full screen
. D REVIEW^DGPFUT3(.DGPFLF,.DGPFLH,"",XQY0,XQORNOD(0))
. ;
. W !,*7
. I $$ANSWER^DGPFUT("Would you like to file this new local record flag","YES","Y")'>0 S DGABORT=1 Q
. ;
. W !,"Filing the new local record flag..."
. ;
. ;-- 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 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[HDGPFLF3 6352 printed Apr 09, 2024@21:42:38 Page 2
DGPFLF3 ;ALB/RBS - PRF FLAG MANAGEMENT LM PROTOCOL ACTIONS CONT. ; 6/9/04 2:05pm
+1 ;;5.3;Registration;**425,554,650**;Aug 13, 1993 ;Build 3
+2 ;
+3 ;no direct entry
+4 QUIT
+5 ;
+6 ;
AF ;Entry point for DGPF ADD FLAG action protocol.
+1 ;
+2 ; Input: DGCAT - flag category (1=National, 2=Local)
+3 ;
+4 ; Output: New 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 vars for EN^DIWE call
NEW DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK
+9 ;return value from call to ^DIR - $$ANSWER^DGPFUT call
NEW DGASK
+10 ;check if word-processing is OK
NEW DGCKWP
+11 ;array containing flag record field values
NEW DGPFLF
+12 ;array containing flag history record field values
NEW DGPFLH
+13 ;abort flag
NEW DGABORT
+14 ;result of $$STOALL^DGPFALF1 api call
NEW DGRESULT
+15 ;review frequency var
NEW DGRDAY
+16 ;notification days var
NEW DGNDAY
+17 ;if error returned
NEW DGERR
+18 ;ok flag to enter record flag entry & flag description
NEW DGOK
+19 ;user message
NEW DGMSG
+20 ;quit flag
NEW DGQ
+21 ;
+22 ;init vars
+23 SET DGOK=1
SET (DGQ,DGABORT)=0
+24 ;
+25 ;set screen to full scrolling region
+26 DO FULL^VALM1
+27 WRITE !
+28 ;
+29 ;check flag category (only Category II flags can be created)
+30 IF DGCAT=1
Begin DoDot:1
+31 DO BLD^DIALOG(261129,"Can not add 'Category I' flags.","","DGERR","F")
+32 DO MSG^DIALOG("WE","","","","DGERR")
WRITE *7
+33 DO PAUSE^VALM1
+34 SET DGOK=0
End DoDot:1
+35 ;
+36 ;user prompts
+37 if DGOK
Begin DoDot:1
+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
+42 ;
+43 ;-- prompt for flag name, quit if one not entered
+44 SET DGASK=$$ANSWER^DGPFUT("Enter the Record Flag Name","","26.11,.01^^I $D(^DGPF(26.11,""B"",X)) K X W "" *** Flag name already on file""")
+45 IF DGASK=-1!(DGASK=0)
SET DGABORT=1
QUIT
+46 SET DGPFLF("FLAG")=DGASK_U_DGASK
+47 ;
+48 ;-- prompt for status of the flag, quit if one not entered
+49 SET DGASK=$$ANSWER^DGPFUT("Enter the Status of the Flag","ACTIVE","26.11,.02")
+50 IF DGASK<0
SET DGABORT=1
QUIT
+51 SET DGPFLF("STAT")=DGASK_U_$$EXTERNAL^DILFD(26.11,.02,"F",DGASK)
+52 ;
+53 ;-- prompt for flag type, quit if one not entered
+54 SET DGASK=$$ANSWER^DGPFUT("Enter the Type of the Flag","","26.11,.03")
+55 IF DGASK'>0
SET DGABORT=1
QUIT
+56 SET DGPFLF("TYPE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.03,"F",DGASK)
+57 ;
+58 ;-- prompt for principal investigator(s) name for RESEARCH flag type
+59 IF +DGPFLF("TYPE")=2
IF '$$PRININV^DGPFLF6(0,.DGPFLF)
Begin DoDot:2
+60 IF $$ANSWER^DGPFUT("Enter RETURN to continue or '^' to exit","","E")=-1
SET DGABORT=1
End DoDot:2
if DGABORT
QUIT
+61 ;
+62 ;-- prompt for review frequency, quit if user aborts
+63 SET DGASK=$$ANSWER^DGPFUT("Enter the Review Frequency Days","","26.11,.04^^K:$L(X)>4!(X[""."") X")
+64 IF DGASK<0
SET DGABORT=1
QUIT
+65 SET DGPFLF("REVFREQ")=DGASK_U_DGASK
+66 SET DGRDAY=DGASK
+67 IF DGASK=0
Begin DoDot:2
+68 ;-- if review frequency=0, don't ask notification/review group
+69 ; reset both fields
+70 SET DGPFLF("NOTIDAYS")=0_U_0
+71 SET DGPFLF("REVGRP")=""_U_""
+72 ;
End DoDot:2
+73 ;continue to prompt user and check abort logic
IF '$TEST
Begin DoDot:2
+74 ;
+75 ;-- prompt for notification days
+76 SET DGASK=$$ANSWER^DGPFUT("Enter the Notification Days","","26.11,.05^^K:$L(X)>4!(X[""."")!(X>DGRDAY) X")
+77 IF DGASK<0
SET DGABORT=1
QUIT
+78 SET DGPFLF("NOTIDAYS")=DGASK_U_DGASK
+79 ;
+80 SET DGQ=0
+81 FOR
Begin DoDot:3
+82 ;-- prompt for review mail group name, optional entry
+83 SET DGASK=$$ANSWER^DGPFUT("Enter the Review Mail Group","","26.11,.06")
+84 IF DGASK<0
SET DGABORT=1
QUIT
+85 IF DGASK'>0
Begin DoDot:4
+86 WRITE !," >>> You've entered the Review Frequency and Notification Days,"
+87 WRITE !," now enter a Review Mail Group or abort this process.",*7
+88 IF '$$CONTINUE^DGPFUT()
SET DGABORT=1
End DoDot:4
QUIT
+89 ;
+90 SET DGPFLF("REVGRP")=DGASK_U_$$EXTERNAL^DILFD(26.11,.06,"F",DGASK)
+91 ;set entry, quit
SET DGQ=1
End DoDot:3
if (DGQ!DGABORT)
QUIT
End DoDot:2
if DGABORT
QUIT
+92 ;
+93 ;-- prompt for associated TIU PN Title, quit if one not entered
+94 ; There is a DD screen on the (#.07) field - using IA #4380
+95 ; to only display Category II PN Titles not already associated
+96 ; with a Category II (Local) Record Flag name.
+97 ;
+98 SET DGASK=$$ANSWER^DGPFUT("Enter the Progress Note Title","","26.11,.07")
+99 IF DGASK<0
SET DGABORT=1
QUIT
+100 SET DGPFLF("TIUTITLE")=DGASK_U_$$EXTERNAL^DILFD(26.11,.07,"F",DGASK)
+101 ;
+102 ;-- have user enter flag description text (required)
+103 SET DGCKWP=0
+104 SET DGWPROOT=$NAME(^TMP($JOB,"DGPFDESC"))
+105 KILL @DGWPROOT
+106 FOR
Begin DoDot:2
+107 ;needed for line editor
WRITE !,"Enter the description for this new record flag:"
+108 SET DIC=$$OREF^DILF(DGWPROOT)
+109 SET DIWETXT="Patient Record Flag - Flag Description Text"
+110 SET DIWESUB="Flag Description Text"
+111 ;max # of chars allowed to be stored on WP global node
SET DWLW=75
+112 ;if line editor, don't join line
SET DWPK=1
+113 DO EN^DIWE
+114 IF $$CKWP^DGPFUT(DGWPROOT)
SET DGCKWP=1
QUIT
+115 WRITE !,"Flag Description Text is required!",!,*7
+116 IF '$$CONTINUE^DGPFUT()
SET DGABORT=1
End DoDot:2
if (DGCKWP!DGABORT)
QUIT
+117 ;
+118 ;-- quit if required flag description not entered
+119 if DGABORT
QUIT
+120 ;
+121 ;-- place flag description text into assignment array
+122 MERGE DGPFLF("DESC")=@DGWPROOT
KILL @DGWPROOT
+123 ;
+124 ;-- setup remaining flag history array nodes for filing
+125 ; note, the DGPFLH("FLAG") will be setup in $$STOALL^DGPFALF1
+126 ;current date/time
SET DGPFLH("ENTERDT")=$$NOW^XLFDT()
+127 ;current user
SET DGPFLH("ENTERBY")=DUZ
+128 SET DGPFLH("REASON",1,0)="New Local Patient Record Flag entered."
+129 ;
+130 ;-- re-display user's answers on full screen
+131 DO REVIEW^DGPFUT3(.DGPFLF,.DGPFLH,"",XQY0,XQORNOD(0))
+132 ;
+133 WRITE !,*7
+134 IF $$ANSWER^DGPFUT("Would you like to file this new local record flag","YES","Y")'>0
SET DGABORT=1
QUIT
+135 ;
+136 WRITE !,"Filing the new local record flag..."
+137 ;
+138 ;-- file both the (#26.11) & (#26.12) entries
+139 SET DGRESULT=$$STOALL^DGPFALF1(.DGPFLF,.DGPFLH,.DGERR)
+140 ;
+141 WRITE !!," >>> Local record flag was "_$SELECT(+DGRESULT:"filed successfully.",1:"not filed successfully."),*7
+142 ;
+143 DO PAUSE^VALM1
End DoDot:1
+144 ;
+145 IF DGABORT
Begin DoDot:1
+146 WRITE !," >>> The '"_$PIECE($GET(XQORNOD(0)),U,3)_"' action is aborting, nothing has been filed.",*7
+147 ;pause
IF $$ANSWER^DGPFUT("Enter RETURN to continue","","E")
End DoDot:1
+148 ;
+149 ;re-build list of local record flags
+150 DO BLD^DGPFLF
+151 ;
+152 ;return to LM (refresh screen)
+153 SET VALMBCK="R"
+154 QUIT
