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

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

initial load of FOIAVistA 6/30/08 version
File size: 5.3 KB
Line 
1DGPFLMA4 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS CONT. ; 10/18/06 9:41am
2 ;;5.3;Registration;**425,554,650**;Aug 13, 1993;Build 3
3 ;
4 ;no direct entry
5 QUIT
6 ;
7 ;
8CO ;Entry point for DGPF CHANGE ASSIGNMENT OWNERSHIP action protocol.
9 ;
10 ; Input: None
11 ;
12 ; Output:
13 ; VALMBCK - 'R' = refresh screen
14 ;
15 N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DDWC,DWPK ;input vars for EN^DIWE
16 N DGCROOT ;assignment history comment word processing root
17 N DGABORT ;abort flag for entering assignment narrative
18 N DGOK ;ok flag for entering assignment narrative
19 N DGIEN ;assignment ien
20 N DGINST ;institution ien
21 N DGPFA ;assignment array
22 N DGPFAH ;assignment history array
23 N DGRESULT ;result of STOALL api call
24 N DGERR ;error if unable to edit assignment
25 N DGETEXT ;error text
26 N DGPFERR ;if error returned from STOALL api call
27 N DGOWN ;valid owner list array
28 N SEL ;user selection (list item)
29 N VALMY ;output of EN^VALM2 call, array of user selected entries
30 ;
31 ;set screen to full scroll region
32 D FULL^VALM1
33 ;
34 ;quit if selected action is not appropriate
35 I '$D(@VALMAR@("IDX")) D Q
36 . I '$G(DGDFN) S DGETEXT(1)="Patient has not been selected."
37 . E S DGETEXT(1)="Patient has no record flag assignments."
38 . D BLD^DIALOG(261129,.DGETEXT,"","DGERR","F")
39 . D MSG^DIALOG("WE","","","","DGERR") W *7
40 . D PAUSE^VALM1
41 . S VALMBCK="R"
42 ;
43 ;allow user to select a SINGLE flag assignment for ownership change
44 S (DGIEN,VALMBCK)=""
45 D EN^VALM2($G(XQORNOD(0)),"S")
46 ;
47 ;process user selection
48 S SEL=$O(VALMY(""))
49 I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D
50 . S DGIEN=$P($G(@VALMAR@("IDX",SEL,SEL)),U)
51 . S DGDFN=$P($G(@VALMAR@("IDX",SEL,SEL)),U,2)
52 . ;
53 . ;attempt to obtain lock on assignment record
54 . I '$$LOCK^DGPFAA3(DGIEN) D Q
55 . . W !!,"Record flag assignment currently in use, can not be edited!",*7
56 . . D PAUSE^VALM1
57 . ;
58 . ;get assignment into DGPFA array
59 . I '$$GETASGN^DGPFAA(DGIEN,.DGPFA) D Q
60 . . W !!,"Unable to retrieve the record flag assignment selected.",*7
61 . . D PAUSE^VALM1
62 . ;
63 . ;can site change ownership of the assignment?
64 . I '$$CHGOWN^DGPFAA2(.DGPFA,$G(DUZ(2)),"DGERR") D Q
65 . . W !!,"Changing the ownership of this record flag assignment not allowed...",*7
66 . . D MSG^DIALOG("WE","","",5,"DGERR")
67 . . D PAUSE^VALM1
68 . ;
69 . ;prompt for new OWNER SITE of the assignment
70 . ;
71 . ;-create selection list of enabled division owners
72 . S DGINST=0
73 . F S DGINST=$O(^DG(40.8,"APRF",DGINST)) Q:'DGINST D
74 . . I $$TF^XUAF4(DGINST) S DGOWN(DGINST)=""
75 . ;
76 . ;-add treating facilities to selection list for Cat I assignments
77 . I $G(DGPFA("FLAG"))["26.15",$$BLDTFL^DGPFUT2(DGDFN,.DGOWN)
78 . ;
79 . ;-remove existing owner from selection list
80 . K DGOWN(+$G(DGPFA("OWNER")))
81 . ;
82 . S DGPFA("OWNER")=$$ANSWER^DGPFUT("Select new owner site for this record flag assignment","","P^4:EMZ","","I $D(DGOWN(+Y))")
83 . Q:(DGPFA("OWNER")'>0)
84 . ;
85 . ;prompt for APPROVED BY person
86 . S DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ")
87 . Q:(DGPFAH("APPRVBY")'>0)
88 . ;
89 . ;allow user to enter HISTORY COMMENTS (edit reason)
90 . S DGCROOT=$NA(^TMP($J,"DGPFCMNT")) ;init WP array for hist comments
91 . K @DGCROOT
92 . S (DGABORT,DGOK)=0
93 . F D Q:(DGOK!DGABORT)
94 . . W !!,"Enter the reason for editing this assignment:" ;needed for line editor
95 . . S @DGCROOT@(1,0)="Change of flag assignment ownership. "
96 . . S DIC=$$OREF^DILF(DGCROOT)
97 . . S DIWETXT="Enter the reason for record flag assignment ownership change:"
98 . . S DIWESUB="Change of Ownership Reason"
99 . . S DWLW=75 ;max # of chars allowed to be stored on WP global node
100 . . S DWPK=1 ;if line editor, don't join lines
101 . . S DDWC="E" ;initially place cursor at end of line 1
102 . . D EN^DIWE
103 . . I $$CKWP^DGPFUT(DGCROOT) S DGOK=1 Q
104 . . W !,"The reason for editing this record flag assignment is required!",*7
105 . . I '$$CONTINUE^DGPFUT() S DGABORT=1
106 . ;
107 . ;quit if required HISTORY COMMENTS not entered
108 . Q:$G(DGABORT)
109 . ;
110 . ;place HISTORY COMMENTS into history array
111 . M DGPFAH("COMMENT")=@DGCROOT K @DGCROOT
112 . ;
113 . ;setup remaining assignment history array nodes for filing
114 . S DGPFAH("ACTION")=2 ;continue
115 . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT() ;current date/time
116 . S DGPFAH("ENTERBY")=DUZ ;current user
117 . ;
118 . ;relinquishing ownership should remove existing review date when
119 . ;new owner is not a local division
120 . I '$D(^DG(40.8,"APRF",DGPFA("OWNER"))) S DGPFA("REVIEWDT")=""
121 . ;
122 . ;display flag assignment review screen to user
123 . D REVIEW^DGPFUT3(.DGPFA,.DGPFAH,DGIEN,XQY0,XQORNOD(0))
124 . ;
125 . ;ask user if ok to file ownership change
126 . Q:$$ANSWER^DGPFUT("Would you like to file the assignment ownership change","YES","Y")'>0
127 . ;
128 . ;file the assignment and history using STOALL api
129 . W !!,"Updating the ownership of this patient's record flag assignment..."
130 . S DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR)
131 . W !?5,"Update was "_$S(+$G(DGRESULT):"successful",1:"not successful")_"."
132 . ;
133 . ;send HL7 ORU msg if editing assignment to a Cat I flag
134 . I +$G(DGRESULT),$G(DGPFA("FLAG"))["26.15",$$SNDORU^DGPFHLS(+DGRESULT) D
135 . . W !?5,"Message sent...updating patient's sites of record."
136 . ;
137 . D PAUSE^VALM1
138 . ;
139 . ;rebuild list of flag assignments for patient
140 . D BLDLIST^DGPFLMU(DGDFN)
141 . ;
142 . ;release lock after CO edit
143 . D UNLOCK^DGPFAA3(DGIEN)
144 ;
145 ;return to LM (refresh screen)
146 S VALMBCK="R"
147 ;
148 Q
Note: See TracBrowser for help on using the repository browser.