DGPFLMA3 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS CONT. ; 6/2/05 3:24pm
;;5.3;Registration;**425,623,554,650,1015**;Aug 13, 1993;Build 21
;
;no direct entry
QUIT
;
EF ;Entry point for DGPF EDIT FLAG ASSIGNMENT action protocol.
;
; Input: None
;
; Output:
; VALMBCK - 'R' = refresh screen
;
;input vars for EN^DIWE call
N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK
N DGAROOT ;assignment narrative word processing root
N DGCROOT ;assignment history comment word processing root
N DGABORT ;abort flag for entering assignment narrative
N DGASK ;return value from $$ANSWER^DGPFUT call
N DGOK ;ok flag for entering assignment narrative
N DGCODE ;action code
N DGDFN ;pointer to patient in PATIENT (#2) file
N DGIEN ;assignment ien
N DGPFA ;assignment array
N DGPFAH ;assignment history array
N DGPFERR ;if error returned from STOALL api call
N DGQ ;quit var for narrative edit
N DGRDAT ;review date
N DGRESULT ;result of STOALL api call
N DGERR ;error if unable to edit assignment
N DGETEXT ;error text
N DGSUB ;for loop var
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 editing
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!"
. . D PAUSE^VALM1
. ;
. ;init word processing arrays
. S DGAROOT=$NA(^TMP($J,"DGPFNARR"))
. S DGCROOT=$NA(^TMP($J,"DGPFCMNT"))
. K @DGAROOT,@DGCROOT
. ;
. ;get assignment into DGPFA array
. I '$$GETASGN^DGPFAA(DGIEN,.DGPFA) D Q
. . W !!,"Unable to retrieve the record flag assignment selected."
. . D PAUSE^VALM1
. ;
. ;is assignment edit allowed?
. I '$$EDTOK^DGPFAA2(.DGPFA,DUZ(2),"DGERR") D Q
. . W !!,"Assignment can not be edited..."
. . D MSG^DIALOG("WE","","",5,"DGERR")
. . D PAUSE^VALM1
. ;
. ;-if assigment is active, set available action codes to Continue
. ; and Inactivate; else set code to Reactivate
. ;-if Local Flag or PRF Phase 2 active, add Entered in Error code
. I +DGPFA("STATUS")=1 D
. . S DGCODE="S^C:Continue Assignment;I:Inactivate Assignment"
. . I $$P2ON^DGPFPARM()!(DGPFA("FLAG")[26.11) S DGCODE=DGCODE_";E:Entered in Error"
. E S DGCODE="S^R:Reactivate Assignment"
. ;
. ;prompt user for assignment action, quit if no action selected
. S DGPFAH("ACTION")=$$ANSWER^DGPFUT("Select an assignment action","",DGCODE)
. Q:(DGPFAH("ACTION")=-1)
. S DGPFAH("ACTION")=$S(DGPFAH("ACTION")="C":2,DGPFAH("ACTION")="I":3,DGPFAH("ACTION")="R":4,DGPFAH("ACTION")="E":5)
. ;
. ;if assignment action is 'Inactivate' or 'Entered in Error',
. ;set status to 'Inactive'. default='Active'.
. S DGPFA("STATUS")=$S(DGPFAH("ACTION")=3:0,DGPFAH("ACTION")=5:0,1:1)
. ;
. ;if action is not 'Inactivate', then prompt user to edit the narr
. S (DGABORT,DGOK,DGQ)=0
. I (DGPFAH("ACTION")'=3) D
. . F D Q:(DGOK!DGABORT!DGQ)
. . . ; if action code not 'Entered in Error', can't force edit
. . . I DGPFAH("ACTION")'=5 D Q:(DGQ!DGABORT)
. . . . S DGASK=$$ANSWER^DGPFUT("Would you like to edit the assignment narrative","YES","Y")
. . . . I DGASK<0 S DGABORT=1 Q ;abort edit action
. . . . I DGASK'=1 S DGQ=1 Q
. . . ;
. . . ;--edit narrative - only '5;Entered in Error' Required
. . . ;--edit the assignment narrative
. . . S DGAROOT=$$GET1^DIQ(26.13,DGIEN,"1","Z",DGAROOT)
. . . S DIC=$$OREF^DILF(DGAROOT)
. . . S DIWETXT="Patient Record Flag - Assignment Narrative Text"
. . . S DIWESUB="Assignment Narrative Text"
. . . S DWLW=75 ;max # of chars allowed to be stored on WP global node
. . . S DWPK=1 ;if line editor, don't join lines
. . . D EN^DIWE
. . . I '$$CKWP^DGPFUT(DGAROOT) D Q
. . . . W !,"Assignment Narrative Text is required!",*7
. . . . I '$$CONTINUE^DGPFUT() S DGABORT=1
. . . ;if number of text lines not the same, a change was made
. . . I $O(DGPFA("NARR",""),-1)'=$O(@DGAROOT@(""),-1) S DGOK=1 Q
. . . ;now check for a difference in text line content
. . . S DGSUB=0
. . . F S DGSUB=$O(DGPFA("NARR",DGSUB)) Q:DGSUB="" D Q:DGOK
. . . . I DGPFA("NARR",DGSUB,0)'=@DGAROOT@(DGSUB,0) S DGOK=1
. . . Q:DGOK
. . . I 'DGOK,(DGPFAH("ACTION")=5) D Q ;required edit
. . . . W !!,"No editing was found to the Narrative text."
. . . . W !,"For 'Entered in Error' Action, you must edit the Assignment Narrative Text.",*7,!
. . . . I '$$CONTINUE^DGPFUT() S DGABORT=1
. . . S DGOK=1
. ;
. Q:$G(DGABORT)
. ;
. ;if narrative edited, place new narrative into DGPFA array
. I $G(DGOK) D
. . K DGPFA("NARR") ;remove old narrative text
. . M DGPFA("NARR")=@DGAROOT K @DGAROOT
. ;
. ;prompt user for 'Approved By' person, quit if not selected
. S DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ")
. Q:(DGPFAH("APPRVBY")'>0)
. ;
. ;have user enter the edit reason/history comments (required)
. S (DGABORT,DGOK)=0
. F D Q:(DGOK!DGABORT)
. . W !!,"Enter the reason for editing this assignment:" ;needed for line editor
. . S DIC=$$OREF^DILF(DGCROOT)
. . S DIWETXT="Patient Record Flag - Edit Reason Text"
. . S DIWESUB="Edit Reason Text"
. . S DWLW=75 ;max # of chars allowed to be stored on WP global node
. . S DWPK=1 ;if line editor, don't join lines
. . D EN^DIWE
. . I $$CKWP^DGPFUT(DGCROOT) S DGOK=1 Q
. . W !,"Edit Reason is required!",*7
. . I '$$CONTINUE^DGPFUT() S DGABORT=1
. ;
. ;quit if required edit reason/history comments not entered
. Q:$G(DGABORT)
. ;
. ;place comments into history array
. M DGPFAH("COMMENT")=@DGCROOT K @DGCROOT
. ;
. ;setup remaining assignment history nodes for filing
. S DGPFAH("ASSIGNDT")=$$NOW^XLFDT() ;current date/time
. S DGPFAH("ENTERBY")=DUZ ;current user
. ;
. ;calculate the default review date
. S DGRDAT=$$GETRDT^DGPFAA3($P(DGPFA("FLAG"),U),DGPFAH("ASSIGNDT"))
. ;
. ;prompt for review date when valid default review date and ACTIVE
. ;status, otherwise null
. I DGRDAT>0,DGPFA("STATUS")=1 D
. . S DGPFA("REVIEWDT")=$$ANSWER^DGPFUT("Enter Review Date",$$FMTE^XLFDT(DGRDAT,"5D"),"D^"_DT_":"_DGRDAT_":EX")
. E S DGPFA("REVIEWDT")=""
. Q:DGPFA("REVIEWDT")<0
. ;
. ;display flag assignment review screen to user
. D REVIEW^DGPFUT3(.DGPFA,.DGPFAH,DGIEN,XQY0,XQORNOD(0))
. ;
. Q:$$ANSWER^DGPFUT("Would you like to file the assignment changes","YES","Y")'>0
. ;
. ;file the assignment and history using STOALL api
. W !,"Updating the patient's record flag assignment..."
. S DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR)
. W !?5,"Assignment was "_$S(+$G(DGRESULT):"filed successfully.",1:"not filed successfully.")
. ;
. ;send HL7 message if editing assignment to a CAT I flag
. I $G(DGRESULT),DGPFA("FLAG")["26.15",$$SNDORU^DGPFHLS(+DGRESULT) D
. . W !?5,"Message sent...updating patient's sites of record."
. ;
. D PAUSE^VALM1
. ;
. ;re-build list of flag assignments for patient
. D BLDLIST^DGPFLMU(DGDFN)
;
;release lock after edit
D UNLOCK^DGPFAA3(DGIEN)
;
;return to LM (refresh screen)
S VALMBCK="R"
;
Q
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
+2 ;
+3 ;no direct entry
+4 QUIT
+5 ;
EF ;Entry point for DGPF EDIT FLAG ASSIGNMENT action protocol.
+1 ;
+2 ; Input: None
+3 ;
+4 ; Output:
+5 ; VALMBCK - 'R' = refresh screen
+6 ;
+7 ;input vars for EN^DIWE call
+8 NEW DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK
+9 ;assignment narrative word processing root
NEW DGAROOT
+10 ;assignment history comment word processing root
NEW DGCROOT
+11 ;abort flag for entering assignment narrative
NEW DGABORT
+12 ;return value from $$ANSWER^DGPFUT call
NEW DGASK
+13 ;ok flag for entering assignment narrative
NEW DGOK
+14 ;action code
NEW DGCODE
+15 ;pointer to patient in PATIENT (#2) file
NEW DGDFN
+16 ;assignment ien
NEW DGIEN
+17 ;assignment array
NEW DGPFA
+18 ;assignment history array
NEW DGPFAH
+19 ;if error returned from STOALL api call
NEW DGPFERR
+20 ;quit var for narrative edit
NEW DGQ
+21 ;review date
NEW DGRDAT
+22 ;result of STOALL api call
NEW DGRESULT
+23 ;error if unable to edit assignment
NEW DGERR
+24 ;error text
NEW DGETEXT
+25 ;for loop var
NEW DGSUB
+26 ;user selection (list item)
NEW SEL
+27 ;output of EN^VALM2 call, array of user selected entries
NEW VALMY
+28 ;
+29 ;set screen to full scroll region
+30 DO FULL^VALM1
+31 ;
+32 ;quit if selected action is not appropriate
+33 IF '$DATA(@VALMAR@("IDX"))
Begin DoDot:1
+34 IF '$GET(DGDFN)
SET DGETEXT(1)="Patient has not been selected."
+35 IF '$TEST
SET DGETEXT(1)="Patient has no record flag assignments."
+36 DO BLD^DIALOG(261129,.DGETEXT,"","DGERR","F")
+37 DO MSG^DIALOG("WE","","","","DGERR")
WRITE *7
+38 DO PAUSE^VALM1
+39 SET VALMBCK="R"
End DoDot:1
QUIT
+40 ;
+41 ;allow user to select a SINGLE flag assignment for editing
+42 SET (DGIEN,VALMBCK)=""
+43 DO EN^VALM2($GET(XQORNOD(0)),"S")
+44 ;
+45 ;process user selection
+46 SET SEL=$ORDER(VALMY(""))
+47 IF SEL
IF $DATA(@VALMAR@("IDX",SEL,SEL))
Begin DoDot:1
+48 SET DGIEN=$PIECE($GET(@VALMAR@("IDX",SEL,SEL)),U)
+49 SET DGDFN=$PIECE($GET(@VALMAR@("IDX",SEL,SEL)),U,2)
+50 ;
+51 ;attempt to obtain lock on assignment record
+52 IF '$$LOCK^DGPFAA3(DGIEN)
Begin DoDot:2
+53 WRITE !!,"Record flag assignment currently in use, can not be edited!"
+54 DO PAUSE^VALM1
End DoDot:2
QUIT
+55 ;
+56 ;init word processing arrays
+57 SET DGAROOT=$NAME(^TMP($JOB,"DGPFNARR"))
+58 SET DGCROOT=$NAME(^TMP($JOB,"DGPFCMNT"))
+59 KILL @DGAROOT,@DGCROOT
+60 ;
+61 ;get assignment into DGPFA array
+62 IF '$$GETASGN^DGPFAA(DGIEN,.DGPFA)
Begin DoDot:2
+63 WRITE !!,"Unable to retrieve the record flag assignment selected."
+64 DO PAUSE^VALM1
End DoDot:2
QUIT
+65 ;
+66 ;is assignment edit allowed?
+67 IF '$$EDTOK^DGPFAA2(.DGPFA,DUZ(2),"DGERR")
Begin DoDot:2
+68 WRITE !!,"Assignment can not be edited..."
+69 DO MSG^DIALOG("WE","","",5,"DGERR")
+70 DO PAUSE^VALM1
End DoDot:2
QUIT
+71 ;
+72 ;-if assigment is active, set available action codes to Continue
+73 ; and Inactivate; else set code to Reactivate
+74 ;-if Local Flag or PRF Phase 2 active, add Entered in Error code
+75 IF +DGPFA("STATUS")=1
Begin DoDot:2
+76 SET DGCODE="S^C:Continue Assignment;I:Inactivate Assignment"
+77 IF $$P2ON^DGPFPARM()!(DGPFA("FLAG")[26.11)
SET DGCODE=DGCODE_";E:Entered in Error"
End DoDot:2
+78 IF '$TEST
SET DGCODE="S^R:Reactivate Assignment"
+79 ;
+80 ;prompt user for assignment action, quit if no action selected
+81 SET DGPFAH("ACTION")=$$ANSWER^DGPFUT("Select an assignment action","",DGCODE)
+82 IF (DGPFAH("ACTION")=-1)
QUIT
+83 SET DGPFAH("ACTION")=$SELECT(DGPFAH("ACTION")="C":2,DGPFAH("ACTION")="I":3,DGPFAH("ACTION")="R":4,DGPFAH("ACTION")="E":5)
+84 ;
+85 ;if assignment action is 'Inactivate' or 'Entered in Error',
+86 ;set status to 'Inactive'. default='Active'.
+87 SET DGPFA("STATUS")=$SELECT(DGPFAH("ACTION")=3:0,DGPFAH("ACTION")=5:0,1:1)
+88 ;
+89 ;if action is not 'Inactivate', then prompt user to edit the narr
+90 SET (DGABORT,DGOK,DGQ)=0
+91 IF (DGPFAH("ACTION")'=3)
Begin DoDot:2
+92 FOR
Begin DoDot:3
+93 ; if action code not 'Entered in Error', can't force edit
+94 IF DGPFAH("ACTION")'=5
Begin DoDot:4
+95 SET DGASK=$$ANSWER^DGPFUT("Would you like to edit the assignment narrative","YES","Y")
+96 ;abort edit action
IF DGASK<0
SET DGABORT=1
QUIT
+97 IF DGASK'=1
SET DGQ=1
QUIT
End DoDot:4
IF (DGQ!DGABORT)
QUIT
+98 ;
+99 ;--edit narrative - only '5;Entered in Error' Required
+100 ;--edit the assignment narrative
+101 SET DGAROOT=$$GET1^DIQ(26.13,DGIEN,"1","Z",DGAROOT)
+102 SET DIC=$$OREF^DILF(DGAROOT)
+103 SET DIWETXT="Patient Record Flag - Assignment Narrative Text"
+104 SET DIWESUB="Assignment Narrative Text"
+105 ;max # of chars allowed to be stored on WP global node
SET DWLW=75
+106 ;if line editor, don't join lines
SET DWPK=1
+107 DO EN^DIWE
+108 IF '$$CKWP^DGPFUT(DGAROOT)
Begin DoDot:4
+109 WRITE !,"Assignment Narrative Text is required!",*7
+110 IF '$$CONTINUE^DGPFUT()
SET DGABORT=1
End DoDot:4
QUIT
+111 ;if number of text lines not the same, a change was made
+112 IF $ORDER(DGPFA("NARR",""),-1)'=$ORDER(@DGAROOT@(""),-1)
SET DGOK=1
QUIT
+113 ;now check for a difference in text line content
+114 SET DGSUB=0
+115 FOR
SET DGSUB=$ORDER(DGPFA("NARR",DGSUB))
IF DGSUB=""
QUIT
Begin DoDot:4
+116 IF DGPFA("NARR",DGSUB,0)'=@DGAROOT@(DGSUB,0)
SET DGOK=1
End DoDot:4
IF DGOK
QUIT
+117 IF DGOK
QUIT
+118 ;required edit
IF 'DGOK
IF (DGPFAH("ACTION")=5)
Begin DoDot:4
+119 WRITE !!,"No editing was found to the Narrative text."
+120 WRITE !,"For 'Entered in Error' Action, you must edit the Assignment Narrative Text.",*7,!
+121 IF '$$CONTINUE^DGPFUT()
SET DGABORT=1
End DoDot:4
QUIT
+122 SET DGOK=1
End DoDot:3
IF (DGOK!DGABORT!DGQ)
QUIT
End DoDot:2
+123 ;
+124 IF $GET(DGABORT)
QUIT
+125 ;
+126 ;if narrative edited, place new narrative into DGPFA array
+127 IF $GET(DGOK)
Begin DoDot:2
+128 ;remove old narrative text
KILL DGPFA("NARR")
+129 MERGE DGPFA("NARR")=@DGAROOT
KILL @DGAROOT
End DoDot:2
+130 ;
+131 ;prompt user for 'Approved By' person, quit if not selected
+132 SET DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ")
+133 IF (DGPFAH("APPRVBY")'>0)
QUIT
+134 ;
+135 ;have user enter the edit reason/history comments (required)
+136 SET (DGABORT,DGOK)=0
+137 FOR
Begin DoDot:2
+138 ;needed for line editor
WRITE !!,"Enter the reason for editing this assignment:"
+139 SET DIC=$$OREF^DILF(DGCROOT)
+140 SET DIWETXT="Patient Record Flag - Edit Reason Text"
+141 SET DIWESUB="Edit Reason Text"
+142 ;max # of chars allowed to be stored on WP global node
SET DWLW=75
+143 ;if line editor, don't join lines
SET DWPK=1
+144 DO EN^DIWE
+145 IF $$CKWP^DGPFUT(DGCROOT)
SET DGOK=1
QUIT
+146 WRITE !,"Edit Reason is required!",*7
+147 IF '$$CONTINUE^DGPFUT()
SET DGABORT=1
End DoDot:2
IF (DGOK!DGABORT)
QUIT
+148 ;
+149 ;quit if required edit reason/history comments not entered
+150 IF $GET(DGABORT)
QUIT
+151 ;
+152 ;place comments into history array
+153 MERGE DGPFAH("COMMENT")=@DGCROOT
KILL @DGCROOT
+154 ;
+155 ;setup remaining assignment history nodes for filing
+156 ;current date/time
SET DGPFAH("ASSIGNDT")=$$NOW^XLFDT()
+157 ;current user
SET DGPFAH("ENTERBY")=DUZ
+158 ;
+159 ;calculate the default review date
+160 SET DGRDAT=$$GETRDT^DGPFAA3($PIECE(DGPFA("FLAG"),U),DGPFAH("ASSIGNDT"))
+161 ;
+162 ;prompt for review date when valid default review date and ACTIVE
+163 ;status, otherwise null
+164 IF DGRDAT>0
IF DGPFA("STATUS")=1
Begin DoDot:2
+165 SET DGPFA("REVIEWDT")=$$ANSWER^DGPFUT("Enter Review Date",$$FMTE^XLFDT(DGRDAT,"5D"),"D^"_DT_":"_DGRDAT_":EX")
End DoDot:2
+166 IF '$TEST
SET DGPFA("REVIEWDT")=""
+167 IF DGPFA("REVIEWDT")<0
QUIT
+168 ;
+169 ;display flag assignment review screen to user
+170 DO REVIEW^DGPFUT3(.DGPFA,.DGPFAH,DGIEN,XQY0,XQORNOD(0))
+171 ;
+172 IF $$ANSWER^DGPFUT("Would you like to file the assignment changes","YES","Y")'>0
QUIT
+173 ;
+174 ;file the assignment and history using STOALL api
+175 WRITE !,"Updating the patient's record flag assignment..."
+176 SET DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR)
+177 WRITE !?5,"Assignment was "_$SELECT(+$GET(DGRESULT):"filed successfully.",1:"not filed successfully.")
+178 ;
+179 ;send HL7 message if editing assignment to a CAT I flag
+180 IF $GET(DGRESULT)
IF DGPFA("FLAG")["26.15"
IF $$SNDORU^DGPFHLS(+DGRESULT)
Begin DoDot:2
+181 WRITE !?5,"Message sent...updating patient's sites of record."
End DoDot:2
+182 ;
+183 DO PAUSE^VALM1
+184 ;
+185 ;re-build list of flag assignments for patient
+186 DO BLDLIST^DGPFLMU(DGDFN)
End DoDot:1
+187 ;
+188 ;release lock after edit
+189 DO UNLOCK^DGPFAA3(DGIEN)
+190 ;
+191 ;return to LM (refresh screen)
+192 SET VALMBCK="R"
+193 ;
+194 QUIT
