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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1DGPFLMA2 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS CONT. ; 6/12/06 12:46pm
2 ;;5.3;Registration;**425,623,554,650**;Aug 13, 1993;Build 3
3 ;
4 ;no direct entry
5 QUIT
6 ;
7AF ;Entry point for DGPF ASSIGN FLAG action protocol.
8 ;
9 ; Input:
10 ; DGDFN - pointer to patient in PATIENT (#2) file
11 ;
12 ; Output:
13 ; VALMBCK - 'R' = refresh screen
14 ;
15 N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK ;input vars for EN^DIWE call
16 N DGABORT ;abort flag for entering assignment narrative
17 N DGFAC ;pointer to INSTITUTION (#4) file
18 N DGOK ;ok flag for entering assignment narrative
19 N DGPFA ;assignment array
20 N DGPFAH ;assignment history array
21 N DGRDAT ;results of review date calculation
22 N DGRESULT ;result of STOALL api call
23 N DGERR ;if unable to add assignment
24 N DGPFERR ;if error returned from STOALL
25 ;
26 ;set screen to full scroll region
27 D FULL^VALM1
28 ;
29 ;quit if patient not selected
30 I '$G(DGDFN) D Q
31 . D BLD^DIALOG(261129,"Patient has not been selected.","","DGERR","F")
32 . D MSG^DIALOG("WE","","","","DGERR") W *7
33 . D PAUSE^VALM1
34 . S VALMBCK="R"
35 ;
36 ;is user's DUZ(2) an enabled Division for PRF ASSIGNMENT OWNERSHIP
37 I '$D(^DG(40.8,"APRF",+$G(DUZ(2)))) D Q
38 . D BLD^DIALOG(261129,"Your Division, "_$$STA^XUAF4($G(DUZ(2)))_", is not enabled for PRF Assignment Ownership.","","DGERR","F")
39 . D MSG^DIALOG("WE","","","","DGERR") W *7
40 . D PAUSE^VALM1
41 . S VALMBCK="R"
42 ;
43 D ;drops out of DO block on assignment failure
44 . ;
45 . ;init assignment and history arrays
46 . K DGPFA,DGPFAH
47 . ;
48 . ;get patient DFN into assignment array
49 . S DGPFA("DFN")=$G(DGDFN)
50 . Q:'DGPFA("DFN")
51 . ;
52 . ;select flag for assignment
53 . S DGPFA("FLAG")=$$ANSWER^DGPFUT("Select a flag for this assignment","","26.13,.02")
54 . Q:(DGPFA("FLAG")'>0)
55 . ;
56 . ;National ICN when Cat I assignment?
57 . I $P(DGPFA("FLAG"),U)["26.15",'$$MPIOK^DGPFUT(DGPFA("DFN")) D Q
58 . . W !!,"Unable to proceed with flag assignment..."
59 . . D BLD^DIALOG(261132,"","","DGERR","F")
60 . . D MSG^DIALOG("WE","","","","DGERR") W *7
61 . . D PAUSE^VALM1
62 . ;
63 . ;run query for Cat I assignments
64 . I $P(DGPFA("FLAG"),U)["26.15",$$GETSTAT^DGPFHLL1(DGDFN)'="C" D
65 . . N DGDIFF ;difference between pre and post query count
66 . . N DGFLGCNT ;total count of Cat I flags
67 . . N DGPRECNT ;pre-query count of Cat I assignments
68 . . N DGPSTCNT ;post-query count of Cat I assignments
69 . . ;
70 . . ;get count of current assignments
71 . . S (DGPRECNT,DGPSTCNT)=$$GETALL^DGPFAA(DGDFN,,,1)
72 . . ;
73 . . ;get total count of possible Category I flags
74 . . S DGFLGCNT=$$CNTRECS^DGPFUT1(26.15)
75 . . ;
76 . . ;stop if all flags are assigned
77 . . Q:DGPRECNT=DGFLGCNT
78 . . ;
79 . . ;execute the query...stop on failure
80 . . Q:'$$SNDQRY^DGPFHLS(DGDFN,1,.DGFAC)
81 . . ;
82 . . ;recheck current assignment count
83 . . S DGPSTCNT=$$GETALL^DGPFAA(DGDFN,,,1)
84 . . S DGDIFF=DGPSTCNT-DGPRECNT
85 . . W !!," ",$S(DGDIFF=1:"A ",DGDIFF>1:"",1:"No ")_"Category I patient record flag assignment"_$S(DGDIFF>1!('DGDIFF):"s were",1:" was")_" returned"
86 . . W !," from "_$P($$NS^XUAF4($G(DGFAC)),U)_$S(DGDIFF:" and filed on your system.",1:".")
87 . . W !
88 . . ;
89 . . ;re-build list when flag assignments have been added
90 . . I DGDIFF D BLDLIST^DGPFLMU(DGDFN)
91 . ;
92 . ;ok to add new assignment?
93 . I '$$ADDOK^DGPFAA2(DGPFA("DFN"),$P(DGPFA("FLAG"),U),"DGERR") D Q
94 . . W !!,"Unable to proceed with flag assignment..."
95 . . D MSG^DIALOG("WE","","",5,"DGERR")
96 . . D PAUSE^VALM1
97 . ;
98 . ;prompt for owner site
99 . S DGPFA("OWNER")=$$ANSWER^DGPFUT("Enter Owner Site",$$EXTERNAL^DILFD(26.13,.04,"",DUZ(2),"DGERR"),"P^4:EMZ","","I $D(^DG(40.8,""APRF"",+Y)),$$TF^XUAF4(+Y)")
100 . Q:(DGPFA("OWNER")'>0)
101 . ;
102 . ;prompt user for approved by person, quit if not selected
103 . S DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ")
104 . Q:(DGPFAH("APPRVBY")'>0)
105 . ;
106 . ;have user enter assignment narrative text (required)
107 . S (DGABORT,DGOK)=0
108 . S DGWPROOT=$NA(^TMP($J,"DGPFNARR"))
109 . K @DGWPROOT
110 . F D Q:(DGOK!DGABORT)
111 . . W !!,"Enter Narrative Text for this record flag assignment:" ;needed for line editor
112 . . S DIC=$$OREF^DILF(DGWPROOT)
113 . . S DIWETXT="Patient Record Flag - Assignment Narrative Text"
114 . . S DIWESUB="Assignment Narrative Text"
115 . . S DWLW=75 ;max # of chars allowed to be stored on WP global node
116 . . S DWPK=1 ;if line editor, don't join lines
117 . . D EN^DIWE
118 . . I $$CKWP^DGPFUT(DGWPROOT) S DGOK=1 Q
119 . . W !,"Assignment Narrative Text is required!",*7
120 . . I '$$CONTINUE^DGPFUT() S DGABORT=1
121 . . ;
122 . ;quit if required assignment narrative not entered
123 . Q:$G(DGABORT)
124 . ;
125 . ;place assignment narrative text into assignment array
126 . M DGPFA("NARR")=@DGWPROOT K @DGWPROOT
127 . ;
128 . ;setup remaining assignment and history array nodes for filing
129 . S DGPFA("STATUS")=1 ;active
130 . S DGPFA("ORIGSITE")=DUZ(2) ;current user's login site
131 . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT() ;current date/time
132 . S DGPFAH("ACTION")=1 ;new assignment
133 . S DGPFAH("ENTERBY")=DUZ ;current user
134 . S DGPFAH("COMMENT",1,0)="New record flag assignment."
135 . ;
136 . ;calculate the default review date
137 . S DGRDAT=$$GETRDT^DGPFAA3($P(DGPFA("FLAG"),U),DGPFAH("ASSIGNDT"))
138 . ;
139 . ;prompt for review date on valid default review date, otherwise null
140 . I DGRDAT>0 D
141 . . S DGPFA("REVIEWDT")=$$ANSWER^DGPFUT("Enter Review Date",$$FMTE^XLFDT(DGRDAT,"5D"),"D^"_DT_":"_DGRDAT_":EX")
142 . E S DGPFA("REVIEWDT")=""
143 . Q:DGPFA("REVIEWDT")<0
144 . ;
145 . ;display flag assignment review screen to user
146 . D REVIEW^DGPFUT3(.DGPFA,.DGPFAH,"",XQY0,XQORNOD(0))
147 . ;
148 . Q:$$ANSWER^DGPFUT("Would you like to file this new record flag assignment","YES","Y")'>0
149 . ;
150 . ;file the assignment and history using STOALL api
151 . W !,"Filing the patient's new record flag assignment..."
152 . S DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR)
153 . W !?5,"Assignment was "_$S(+$G(DGRESULT):"filed successfully.",1:"not filed successfully.")
154 . ;
155 . ;send HL7 message if adding an assignment to a CAT I flag
156 . I $G(DGRESULT),DGPFA("FLAG")["26.15",$$SNDORU^DGPFHLS(+DGRESULT) D
157 . . W !?5,"Message sent...updating patient's sites of record."
158 . ;
159 . D PAUSE^VALM1
160 . ;
161 . ;re-build list of flag assignments for patient
162 . D BLDLIST^DGPFLMU(DGDFN)
163 ;
164 S VALMBCK="R"
165 ;
166 Q
Note: See TracBrowser for help on using the repository browser.