Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPFLMA3

DGPFLMA3.m

Go to the documentation of this file. 
  1. DGPFLMA3 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS CONT. ; 6/2/05 3:24pm
  1.  ;;5.3;Registration;**425,623,554,650,1015**;Aug 13, 1993;Build 21
  1.  ;
  1.  ;no direct entry
  1.  QUIT
  1.  ;
  1. EF ;Entry point for DGPF EDIT FLAG ASSIGNMENT action protocol.
  1.  ;
  1.  ;  Input: None
  1.  ;
  1.  ; Output:
  1.  ;   VALMBCK - 'R' = refresh screen
  1.  ;
  1.  ;input vars for EN^DIWE call
  1.  N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK
  1.  N DGAROOT   ;assignment narrative word processing root
  1.  N DGCROOT   ;assignment history comment word processing root
  1.  N DGABORT   ;abort flag for entering assignment narrative
  1.  N DGASK     ;return value from $$ANSWER^DGPFUT call
  1.  N DGOK      ;ok flag for entering assignment narrative
  1.  N DGCODE    ;action code
  1.  N DGDFN     ;pointer to patient in PATIENT (#2) file
  1.  N DGIEN     ;assignment ien
  1.  N DGPFA     ;assignment array
  1.  N DGPFAH    ;assignment history array
  1.  N DGPFERR   ;if error returned from STOALL api call
  1.  N DGQ       ;quit var for narrative edit
  1.  N DGRDAT    ;review date
  1.  N DGRESULT  ;result of STOALL api call
  1.  N DGERR     ;error if unable to edit assignment
  1.  N DGETEXT   ;error text
  1.  N DGSUB     ;for loop var
  1.  N SEL       ;user selection (list item)
  1.  N VALMY     ;output of EN^VALM2 call, array of user selected entries
  1.  ;
  1.  ;set screen to full scroll region
  1.  D FULL^VALM1
  1.  ;
  1.  ;quit if selected action is not appropriate
  1.  I '$D(@VALMAR@("IDX")) D  Q
  1.  . I '$G(DGDFN) S DGETEXT(1)="Patient has not been selected."
  1.  . E  S DGETEXT(1)="Patient has no record flag assignments."
  1.  . D BLD^DIALOG(261129,.DGETEXT,"","DGERR","F")
  1.  . D MSG^DIALOG("WE","","","","DGERR") W *7
  1.  . D PAUSE^VALM1
  1.  . S VALMBCK="R"
  1.  ;
  1.  ;allow user to select a SINGLE flag assignment for editing
  1.  S (DGIEN,VALMBCK)=""
  1.  D EN^VALM2($G(XQORNOD(0)),"S")
  1.  ;
  1.  ;process user selection
  1.  S SEL=$O(VALMY(""))
  1.  I SEL,$D(@VALMAR@("IDX",SEL,SEL)) D
  1.  . S DGIEN=$P($G(@VALMAR@("IDX",SEL,SEL)),U)
  1.  . S DGDFN=$P($G(@VALMAR@("IDX",SEL,SEL)),U,2)
  1.  . ;
  1.  . ;attempt to obtain lock on assignment record
  1.  . I '$$LOCK^DGPFAA3(DGIEN) D  Q
  1.  . . W !!,"Record flag assignment currently in use, can not be edited!"
  1.  . . D PAUSE^VALM1
  1.  . ;
  1.  . ;init word processing arrays 
  1.  . S DGAROOT=$NA(^TMP($J,"DGPFNARR"))
  1.  . S DGCROOT=$NA(^TMP($J,"DGPFCMNT"))
  1.  . K @DGAROOT,@DGCROOT
  1.  . ;
  1.  . ;get assignment into DGPFA array
  1.  . I '$$GETASGN^DGPFAA(DGIEN,.DGPFA) D  Q
  1.  . . W !!,"Unable to retrieve the record flag assignment selected."
  1.  . . D PAUSE^VALM1
  1.  . ;
  1.  . ;is assignment edit allowed?
  1.  . I '$$EDTOK^DGPFAA2(.DGPFA,DUZ(2),"DGERR") D  Q
  1.  . . W !!,"Assignment can not be edited..."
  1.  . . D MSG^DIALOG("WE","","",5,"DGERR")
  1.  . . D PAUSE^VALM1
  1.  . ;
  1.  . ;-if assigment is active, set available action codes to Continue
  1.  . ; and Inactivate; else set code to Reactivate
  1.  . ;-if Local Flag or PRF Phase 2 active, add Entered in Error code
  1.  . I +DGPFA("STATUS")=1 D
  1.  . . S DGCODE="S^C:Continue Assignment;I:Inactivate Assignment"
  1.  . . I $$P2ON^DGPFPARM()!(DGPFA("FLAG")[26.11) S DGCODE=DGCODE_";E:Entered in Error"
  1.  . E  S DGCODE="S^R:Reactivate Assignment"
  1.  . ;
  1.  . ;prompt user for assignment action, quit if no action selected
  1.  . S DGPFAH("ACTION")=$$ANSWER^DGPFUT("Select an assignment action","",DGCODE)
  1.  . Q:(DGPFAH("ACTION")=-1)
  1.  . S DGPFAH("ACTION")=$S(DGPFAH("ACTION")="C":2,DGPFAH("ACTION")="I":3,DGPFAH("ACTION")="R":4,DGPFAH("ACTION")="E":5)
  1.  . ;
  1.  . ;if assignment action is 'Inactivate' or 'Entered in Error',
  1.  . ;set status to 'Inactive'. default='Active'.
  1.  . S DGPFA("STATUS")=$S(DGPFAH("ACTION")=3:0,DGPFAH("ACTION")=5:0,1:1)
  1.  . ;
  1.  . ;if action is not 'Inactivate', then prompt user to edit the narr
  1.  . S (DGABORT,DGOK,DGQ)=0
  1.  . I (DGPFAH("ACTION")'=3) D
  1.  . . F  D  Q:(DGOK!DGABORT!DGQ)
  1.  . . . ; if action code not 'Entered in Error', can't force edit
  1.  . . . I DGPFAH("ACTION")'=5 D  Q:(DGQ!DGABORT)
  1.  . . . . S DGASK=$$ANSWER^DGPFUT("Would you like to edit the assignment narrative","YES","Y")
  1.  . . . . I DGASK<0 S DGABORT=1 Q  ;abort edit action
  1.  . . . . I DGASK'=1 S DGQ=1 Q
  1.  . . . ;
  1.  . . . ;--edit narrative - only '5;Entered in Error' Required
  1.  . . . ;--edit the assignment narrative
  1.  . . . S DGAROOT=$$GET1^DIQ(26.13,DGIEN,"1","Z",DGAROOT)
  1.  . . . S DIC=$$OREF^DILF(DGAROOT)
  1.  . . . S DIWETXT="Patient Record Flag - Assignment Narrative Text"
  1.  . . . S DIWESUB="Assignment Narrative Text"
  1.  . . . S DWLW=75 ;max # of chars allowed to be stored on WP global node
  1.  . . . S DWPK=1  ;if line editor, don't join lines
  1.  . . . D EN^DIWE
  1.  . . . I '$$CKWP^DGPFUT(DGAROOT) D  Q
  1.  . . . . W !,"Assignment Narrative Text is required!",*7
  1.  . . . . I '$$CONTINUE^DGPFUT() S DGABORT=1
  1.  . . . ;if number of text lines not the same, a change was made
  1.  . . . I $O(DGPFA("NARR",""),-1)'=$O(@DGAROOT@(""),-1) S DGOK=1 Q
  1.  . . . ;now check for a difference in text line content
  1.  . . . S DGSUB=0
  1.  . . . F  S DGSUB=$O(DGPFA("NARR",DGSUB)) Q:DGSUB=""  D  Q:DGOK
  1.  . . . . I DGPFA("NARR",DGSUB,0)'=@DGAROOT@(DGSUB,0) S DGOK=1
  1.  . . . Q:DGOK
  1.  . . . I 'DGOK,(DGPFAH("ACTION")=5) D  Q  ;required edit
  1.  . . . . W !!,"No editing was found to the Narrative text."
  1.  . . . . W !,"For 'Entered in Error' Action, you must edit the Assignment Narrative Text.",*7,!
  1.  . . . . I '$$CONTINUE^DGPFUT() S DGABORT=1
  1.  . . . S DGOK=1
  1.  . ;
  1.  . Q:$G(DGABORT)
  1.  . ;
  1.  . ;if narrative edited, place new narrative into DGPFA array
  1.  . I $G(DGOK) D
  1.  . . K DGPFA("NARR")  ;remove old narrative text
  1.  . . M DGPFA("NARR")=@DGAROOT K @DGAROOT
  1.  . ;
  1.  . ;prompt user for 'Approved By' person, quit if not selected
  1.  . S DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ")
  1.  . Q:(DGPFAH("APPRVBY")'>0)
  1.  . ;
  1.  . ;have user enter the edit reason/history comments (required)
  1.  . S (DGABORT,DGOK)=0
  1.  . F  D  Q:(DGOK!DGABORT)
  1.  . . W !!,"Enter the reason for editing this assignment:"  ;needed for line editor
  1.  . . S DIC=$$OREF^DILF(DGCROOT)
  1.  . . S DIWETXT="Patient Record Flag - Edit Reason Text"
  1.  . . S DIWESUB="Edit Reason Text"
  1.  . . S DWLW=75 ;max # of chars allowed to be stored on WP global node
  1.  . . S DWPK=1  ;if line editor, don't join lines
  1.  . . D EN^DIWE
  1.  . . I $$CKWP^DGPFUT(DGCROOT) S DGOK=1 Q
  1.  . . W !,"Edit Reason is required!",*7
  1.  . . I '$$CONTINUE^DGPFUT() S DGABORT=1
  1.  . ;
  1.  . ;quit if required edit reason/history comments not entered
  1.  . Q:$G(DGABORT)
  1.  . ;
  1.  . ;place comments into history array
  1.  . M DGPFAH("COMMENT")=@DGCROOT K @DGCROOT
  1.  . ;
  1.  . ;setup remaining assignment history nodes for filing
  1.  . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT()  ;current date/time
  1.  . S DGPFAH("ENTERBY")=DUZ             ;current user
  1.  . ;
  1.  . ;calculate the default review date
  1.  . S DGRDAT=$$GETRDT^DGPFAA3($P(DGPFA("FLAG"),U),DGPFAH("ASSIGNDT"))
  1.  . ;
  1.  . ;prompt for review date when valid default review date and ACTIVE
  1.  . ;status, otherwise null
  1.  . I DGRDAT>0,DGPFA("STATUS")=1 D
  1.  . . S DGPFA("REVIEWDT")=$$ANSWER^DGPFUT("Enter Review Date",$$FMTE^XLFDT(DGRDAT,"5D"),"D^"_DT_":"_DGRDAT_":EX")
  1.  . E  S DGPFA("REVIEWDT")=""
  1.  . Q:DGPFA("REVIEWDT")<0
  1.  . ;
  1.  . ;display flag assignment review screen to user
  1.  . D REVIEW^DGPFUT3(.DGPFA,.DGPFAH,DGIEN,XQY0,XQORNOD(0))
  1.  . ;
  1.  . Q:$$ANSWER^DGPFUT("Would you like to file the assignment changes","YES","Y")'>0
  1.  . ;
  1.  . ;file the assignment and history using STOALL api
  1.  . W !,"Updating the patient's record flag assignment..."
  1.  . S DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR)
  1.  . W !?5,"Assignment was "_$S(+$G(DGRESULT):"filed successfully.",1:"not filed successfully.")
  1.  . ;
  1.  . ;send HL7 message if editing assignment to a CAT I flag
  1.  . I $G(DGRESULT),DGPFA("FLAG")["26.15",$$SNDORU^DGPFHLS(+DGRESULT) D
  1.  . . W !?5,"Message sent...updating patient's sites of record."
  1.  . ;
  1.  . D PAUSE^VALM1
  1.  . ;
  1.  . ;re-build list of flag assignments for patient
  1.  . D BLDLIST^DGPFLMU(DGDFN)
  1.  ;
  1.  ;release lock after edit
  1.  D UNLOCK^DGPFAA3(DGIEN)
  1.  ;
  1.  ;return to LM (refresh screen)
  1.  S VALMBCK="R"
  1.  ;
  1.  Q