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