- 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
