source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPFLF3.m@ 1424

Last change on this file since 1424 was 628, checked in by George Lilly, 15 years ago

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