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,864,951,1106**;Aug 13, 1993;Build 1
  1. ; Last Edited: SHRPE/SGM - Sep 25, 2018 17:31
  1. ;NOTES:
  1. ; 1/23/2018 - with addition of DBRS, when to not complete action
  1. ; changes from previous version. One can edit DBRS#
  1. ; only with no other changes.
  1. ; ICR# TYPE DESCRIPTION
  1. ;----- ---- -------------------------------
  1. ; 2050 Sup ^DIALOG: BLD, MSG
  1. ; 2051 Sup UPDATE^DIE
  1. ; 2054 Sup $$OREF^DILF
  1. ; 2056 Sup $$GET1^DIQ
  1. ;10028 Sup EN^DIWE
  1. ;10060 Sup File 200 FM read of all fields
  1. ;10103 Sup ^XLFDT: $$FMTE, $$NOW
  1. ;10113 Sup ^DIK
  1. ;10116 Sup ^VALM1: FULL, PAUSE
  1. ;10119 Sup EN^VALM2
  1. ;
  1. QUIT
  1. ;
  1. EF ;Entry point for DGPF EDIT 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 X,Y,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 $C(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. . N X
  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, cannot 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,1) D Q
  1. . . W !!,"Unable to retrieve the record flag assignment selected."
  1. . . D PAUSE^VALM1
  1. . ;
  1. . ;urgent address as female flag can't be edited dg*5.3*864
  1. . I $P(DGPFA("FLAG"),",",2)="^URGENT ADDRESS AS FEMALE" D Q
  1. . . W !!
  1. . . W !!,"The URGENT ADDRESS AS FEMALE Flag assignment cannot be edited."
  1. . . W !!
  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 assignment 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. . ;-dg*951 - add DBRS edit option. This action is worded to allow
  1. . ; for future fields to be added without having to add new
  1. . ; actions. DBRS edit action only available on actions Continue
  1. . ; and Reactivate
  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. . . I $P(DGPFA("FLAG"),U,2)="BEHAVIORAL" D ; dg*5.3*951
  1. . . . S DGCODE=DGCODE_";X:DBRS/Other Field Edit Only"
  1. . . . Q
  1. . . Q
  1. . E S DGCODE="S^R:Reactivate Assignment"
  1. . ;
  1. . ;prompt user for assignment action, quit if no action selected
  1. . ;"ACTION" will have a value from 1-6 ; dg*951
  1. . S X=$$ANSWER^DGPFUT("Select an assignment action","",DGCODE)
  1. . Q:(X=-1)
  1. . S X=$F("CIREX",X) Q:'X S DGPFAH("ACTION")=X
  1. . ;
  1. . ;if assignment action is 'Inactivate' or 'Entered in Error',
  1. . ;set status to 'Inactive'. default='Active'
  1. . ;if action is DBRS do not change current status; DG*5.3*951
  1. . I DGPFAH("ACTION")'=6 D
  1. . . S DGPFA("STATUS")=$S(DGPFAH("ACTION")=3:0,DGPFAH("ACTION")=5:0,1:1)
  1. . . Q
  1. . ;
  1. . ; DBRS ; DG*5.3*951
  1. . I $$BEH,'$$EIE I '$$DBRSEDIT^DGPFUT6 Q
  1. . ;
  1. . ;if action is not 'Inactivate', then prompt user to edit the narr
  1. . S (DGABORT,DGOK,DGQ)=0
  1. . I 36'[DGPFAH("ACTION") D
  1. . . F D Q:(DGOK!DGABORT!DGQ)
  1. . . . N I,DGTX
  1. . . . ; if action code not 'Entered in Error', can't force edit
  1. . . . I '$$EIE 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,.DGTX) D Q
  1. . . . . W !,"Assignment Narrative Text is required!"_$C(7)
  1. . . . . I $D(DGTX) S I=0 F S I=$O(DGTX(I)) Q:'I W !,DGTX(I)
  1. . . . . I '$$CONTINUE^DGPFUT() S DGABORT=1
  1. . . . . Q
  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,$$EIE 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."_$C(7),!
  1. . . . . I '$$CONTINUE^DGPFUT() S DGABORT=1
  1. . . . S DGOK=1
  1. . . . Q
  1. . . Q
  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. . ;quit if required edit reason/history comments not entered
  1. . S (DGABORT,DGOK)=0
  1. . F D Q:(DGOK!DGABORT)
  1. . . N I,DGTX,DIC,DIWESUB,DIWETXT,DWLW,DWPK
  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,.DGTX) S DGOK=1
  1. . . E D
  1. . . . W !,"Edit Reason is required!"_$C(7)
  1. . . . I $D(DGTX) S I=0 F S I=$O(DGTX(I)) Q:'I W !,DGTX(I)
  1. . . . I '$$CONTINUE^DGPFUT() S DGABORT=1
  1. . . . Q
  1. . . Q
  1. . ;
  1. . ;quit if required edit reason/history comments not entered
  1. . Q:$G(DGABORT)
  1. . ;
  1. . ; place comments into history array
  1. . I 'DGABORT 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. . S DGPFAH("ORIGFAC")=+$$SITE^VASITE ;DG 1106 site entering action
  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. . ; DG*3.5*951 - for new X action, no review date changes
  1. . ; move pre-DG*5.3*951 code inside first argumentless DO
  1. . I DGPFAH("ACTION")<6 D
  1. . . I DGRDAT>0,DGPFA("STATUS")=1 D
  1. . . . N Y,XDT S Y=$$FMTE^XLFDT(DGRDAT,"5D")
  1. . . . S XDT="D^"_DT_":"_DGRDAT_":EX"
  1. . . . S DGPFA("REVIEWDT")=$$ANSWER^DGPFUT("Enter Review Date",Y,XDT)
  1. . . . Q
  1. . . E S DGPFA("REVIEWDT")=""
  1. . . Q
  1. . Q:DGPFA("REVIEWDT")<0
  1. . ;
  1. . ;DG*5.3*951 - update DGPFA() and DGPFAH() as appropriate
  1. . I $$EIE D EIEARR
  1. . S DGPFA("ACTION")=$P(DGPFAH("ACTION"),U)
  1. . ;
  1. . ;display flag assignment review screen to user
  1. . D REVIEW^DGPFUT3(.DGPFA,.DGPFAH,DGIEN,XQY0,XQORNOD(0))
  1. . ;
  1. . ;if EIE,Behavioral flag, display warning ; DG*5.3*951
  1. . I $$EIE,$$BEH D EIE^DGPFUT6(.DGPFAH)
  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,"D")
  1. . S X="Assignment was "_$S('DGRESULT:"not ",1:"")_"filed successfully."
  1. . W !?5,X
  1. . ;
  1. . ;send HL7 message if editing assignment to a CAT I flag
  1. . I DGRESULT,DGPFA("FLAG")["26.15",$$SNDORU^DGPFHLS(+DGRESULT) D
  1. . . W !?5,"Message sent...updating patient's sites of record."
  1. . . Q
  1. . ;
  1. . D PAUSE^VALM1
  1. . ;re-build list of flag assignments for patient
  1. . D BLDLIST^DGPFLMU(DGDFN)
  1. . Q
  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
  1. ;
  1. BEH() ;
  1. N X,Y S X=$G(DGPFA("FLAG"))
  1. S Y=0 I X[26.15,$P(X,U,2)="BEHAVIORAL" S Y=1
  1. Q Y
  1. ;
  1. EIE() ; was this action ENTERED IN ERROR
  1. Q +$G(DGPFAH("ACTION"))=5
  1. ;
  1. EIEARR ;
  1. ; Reset DGPFA() and DGPFAH() for DBRS EIE action
  1. N I,J,X,Y
  1. K DGPFAH("DBRS")
  1. S (I,J)=0 F S I=$O(DGPFA("DBRS#",I)) Q:'I D
  1. . S X=$P(DGPFA("DBRS#",I),U)
  1. . S $P(X,U,2)=$P($G(DGPFA("DBRS OTHER",I)),U)
  1. . S $P(X,U,3)=$P($G(DGPFA("DBRS DATE",I)),U)
  1. . S $P(X,U,4)="D"
  1. . S $P(X,U,5)=$P($G(DGPFA("DBRS SITE",I)),U)
  1. . S J=J+1,DGPFAH("DBRS",J)=X
  1. . Q
  1. F Y="DBRS#","DBRS DATE","DBRS OTHER","DBRS SITE" K DGPFA(Y)
  1. Q