| [613] | 1 | DGPFLMA2 ;ALB/KCL - PRF ASSIGNMENT LM PROTOCOL ACTIONS CONT. ; 6/12/06 12:46pm
|
|---|
| 2 | ;;5.3;Registration;**425,623,554,650**;Aug 13, 1993;Build 3
|
|---|
| 3 | ;
|
|---|
| 4 | ;no direct entry
|
|---|
| 5 | QUIT
|
|---|
| 6 | ;
|
|---|
| 7 | AF ;Entry point for DGPF ASSIGN FLAG action protocol.
|
|---|
| 8 | ;
|
|---|
| 9 | ; Input:
|
|---|
| 10 | ; DGDFN - pointer to patient in PATIENT (#2) file
|
|---|
| 11 | ;
|
|---|
| 12 | ; Output:
|
|---|
| 13 | ; VALMBCK - 'R' = refresh screen
|
|---|
| 14 | ;
|
|---|
| 15 | N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK ;input vars for EN^DIWE call
|
|---|
| 16 | N DGABORT ;abort flag for entering assignment narrative
|
|---|
| 17 | N DGFAC ;pointer to INSTITUTION (#4) file
|
|---|
| 18 | N DGOK ;ok flag for entering assignment narrative
|
|---|
| 19 | N DGPFA ;assignment array
|
|---|
| 20 | N DGPFAH ;assignment history array
|
|---|
| 21 | N DGRDAT ;results of review date calculation
|
|---|
| 22 | N DGRESULT ;result of STOALL api call
|
|---|
| 23 | N DGERR ;if unable to add assignment
|
|---|
| 24 | N DGPFERR ;if error returned from STOALL
|
|---|
| 25 | ;
|
|---|
| 26 | ;set screen to full scroll region
|
|---|
| 27 | D FULL^VALM1
|
|---|
| 28 | ;
|
|---|
| 29 | ;quit if patient not selected
|
|---|
| 30 | I '$G(DGDFN) D Q
|
|---|
| 31 | . D BLD^DIALOG(261129,"Patient has not been selected.","","DGERR","F")
|
|---|
| 32 | . D MSG^DIALOG("WE","","","","DGERR") W *7
|
|---|
| 33 | . D PAUSE^VALM1
|
|---|
| 34 | . S VALMBCK="R"
|
|---|
| 35 | ;
|
|---|
| 36 | ;is user's DUZ(2) an enabled Division for PRF ASSIGNMENT OWNERSHIP
|
|---|
| 37 | I '$D(^DG(40.8,"APRF",+$G(DUZ(2)))) D Q
|
|---|
| 38 | . D BLD^DIALOG(261129,"Your Division, "_$$STA^XUAF4($G(DUZ(2)))_", is not enabled for PRF Assignment Ownership.","","DGERR","F")
|
|---|
| 39 | . D MSG^DIALOG("WE","","","","DGERR") W *7
|
|---|
| 40 | . D PAUSE^VALM1
|
|---|
| 41 | . S VALMBCK="R"
|
|---|
| 42 | ;
|
|---|
| 43 | D ;drops out of DO block on assignment failure
|
|---|
| 44 | . ;
|
|---|
| 45 | . ;init assignment and history arrays
|
|---|
| 46 | . K DGPFA,DGPFAH
|
|---|
| 47 | . ;
|
|---|
| 48 | . ;get patient DFN into assignment array
|
|---|
| 49 | . S DGPFA("DFN")=$G(DGDFN)
|
|---|
| 50 | . Q:'DGPFA("DFN")
|
|---|
| 51 | . ;
|
|---|
| 52 | . ;select flag for assignment
|
|---|
| 53 | . S DGPFA("FLAG")=$$ANSWER^DGPFUT("Select a flag for this assignment","","26.13,.02")
|
|---|
| 54 | . Q:(DGPFA("FLAG")'>0)
|
|---|
| 55 | . ;
|
|---|
| 56 | . ;National ICN when Cat I assignment?
|
|---|
| 57 | . I $P(DGPFA("FLAG"),U)["26.15",'$$MPIOK^DGPFUT(DGPFA("DFN")) D Q
|
|---|
| 58 | . . W !!,"Unable to proceed with flag assignment..."
|
|---|
| 59 | . . D BLD^DIALOG(261132,"","","DGERR","F")
|
|---|
| 60 | . . D MSG^DIALOG("WE","","","","DGERR") W *7
|
|---|
| 61 | . . D PAUSE^VALM1
|
|---|
| 62 | . ;
|
|---|
| 63 | . ;run query for Cat I assignments
|
|---|
| 64 | . I $P(DGPFA("FLAG"),U)["26.15",$$GETSTAT^DGPFHLL1(DGDFN)'="C" D
|
|---|
| 65 | . . N DGDIFF ;difference between pre and post query count
|
|---|
| 66 | . . N DGFLGCNT ;total count of Cat I flags
|
|---|
| 67 | . . N DGPRECNT ;pre-query count of Cat I assignments
|
|---|
| 68 | . . N DGPSTCNT ;post-query count of Cat I assignments
|
|---|
| 69 | . . ;
|
|---|
| 70 | . . ;get count of current assignments
|
|---|
| 71 | . . S (DGPRECNT,DGPSTCNT)=$$GETALL^DGPFAA(DGDFN,,,1)
|
|---|
| 72 | . . ;
|
|---|
| 73 | . . ;get total count of possible Category I flags
|
|---|
| 74 | . . S DGFLGCNT=$$CNTRECS^DGPFUT1(26.15)
|
|---|
| 75 | . . ;
|
|---|
| 76 | . . ;stop if all flags are assigned
|
|---|
| 77 | . . Q:DGPRECNT=DGFLGCNT
|
|---|
| 78 | . . ;
|
|---|
| 79 | . . ;execute the query...stop on failure
|
|---|
| 80 | . . Q:'$$SNDQRY^DGPFHLS(DGDFN,1,.DGFAC)
|
|---|
| 81 | . . ;
|
|---|
| 82 | . . ;recheck current assignment count
|
|---|
| 83 | . . S DGPSTCNT=$$GETALL^DGPFAA(DGDFN,,,1)
|
|---|
| 84 | . . S DGDIFF=DGPSTCNT-DGPRECNT
|
|---|
| 85 | . . W !!," ",$S(DGDIFF=1:"A ",DGDIFF>1:"",1:"No ")_"Category I patient record flag assignment"_$S(DGDIFF>1!('DGDIFF):"s were",1:" was")_" returned"
|
|---|
| 86 | . . W !," from "_$P($$NS^XUAF4($G(DGFAC)),U)_$S(DGDIFF:" and filed on your system.",1:".")
|
|---|
| 87 | . . W !
|
|---|
| 88 | . . ;
|
|---|
| 89 | . . ;re-build list when flag assignments have been added
|
|---|
| 90 | . . I DGDIFF D BLDLIST^DGPFLMU(DGDFN)
|
|---|
| 91 | . ;
|
|---|
| 92 | . ;ok to add new assignment?
|
|---|
| 93 | . I '$$ADDOK^DGPFAA2(DGPFA("DFN"),$P(DGPFA("FLAG"),U),"DGERR") D Q
|
|---|
| 94 | . . W !!,"Unable to proceed with flag assignment..."
|
|---|
| 95 | . . D MSG^DIALOG("WE","","",5,"DGERR")
|
|---|
| 96 | . . D PAUSE^VALM1
|
|---|
| 97 | . ;
|
|---|
| 98 | . ;prompt for owner site
|
|---|
| 99 | . S DGPFA("OWNER")=$$ANSWER^DGPFUT("Enter Owner Site",$$EXTERNAL^DILFD(26.13,.04,"",DUZ(2),"DGERR"),"P^4:EMZ","","I $D(^DG(40.8,""APRF"",+Y)),$$TF^XUAF4(+Y)")
|
|---|
| 100 | . Q:(DGPFA("OWNER")'>0)
|
|---|
| 101 | . ;
|
|---|
| 102 | . ;prompt user for approved by person, quit if not selected
|
|---|
| 103 | . S DGPFAH("APPRVBY")=$$ANSWER^DGPFUT("Approved By","","P^200:EMZ")
|
|---|
| 104 | . Q:(DGPFAH("APPRVBY")'>0)
|
|---|
| 105 | . ;
|
|---|
| 106 | . ;have user enter assignment narrative text (required)
|
|---|
| 107 | . S (DGABORT,DGOK)=0
|
|---|
| 108 | . S DGWPROOT=$NA(^TMP($J,"DGPFNARR"))
|
|---|
| 109 | . K @DGWPROOT
|
|---|
| 110 | . F D Q:(DGOK!DGABORT)
|
|---|
| 111 | . . W !!,"Enter Narrative Text for this record flag assignment:" ;needed for line editor
|
|---|
| 112 | . . S DIC=$$OREF^DILF(DGWPROOT)
|
|---|
| 113 | . . S DIWETXT="Patient Record Flag - Assignment Narrative Text"
|
|---|
| 114 | . . S DIWESUB="Assignment Narrative Text"
|
|---|
| 115 | . . S DWLW=75 ;max # of chars allowed to be stored on WP global node
|
|---|
| 116 | . . S DWPK=1 ;if line editor, don't join lines
|
|---|
| 117 | . . D EN^DIWE
|
|---|
| 118 | . . I $$CKWP^DGPFUT(DGWPROOT) S DGOK=1 Q
|
|---|
| 119 | . . W !,"Assignment Narrative Text is required!",*7
|
|---|
| 120 | . . I '$$CONTINUE^DGPFUT() S DGABORT=1
|
|---|
| 121 | . . ;
|
|---|
| 122 | . ;quit if required assignment narrative not entered
|
|---|
| 123 | . Q:$G(DGABORT)
|
|---|
| 124 | . ;
|
|---|
| 125 | . ;place assignment narrative text into assignment array
|
|---|
| 126 | . M DGPFA("NARR")=@DGWPROOT K @DGWPROOT
|
|---|
| 127 | . ;
|
|---|
| 128 | . ;setup remaining assignment and history array nodes for filing
|
|---|
| 129 | . S DGPFA("STATUS")=1 ;active
|
|---|
| 130 | . S DGPFA("ORIGSITE")=DUZ(2) ;current user's login site
|
|---|
| 131 | . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT() ;current date/time
|
|---|
| 132 | . S DGPFAH("ACTION")=1 ;new assignment
|
|---|
| 133 | . S DGPFAH("ENTERBY")=DUZ ;current user
|
|---|
| 134 | . S DGPFAH("COMMENT",1,0)="New record flag assignment."
|
|---|
| 135 | . ;
|
|---|
| 136 | . ;calculate the default review date
|
|---|
| 137 | . S DGRDAT=$$GETRDT^DGPFAA3($P(DGPFA("FLAG"),U),DGPFAH("ASSIGNDT"))
|
|---|
| 138 | . ;
|
|---|
| 139 | . ;prompt for review date on valid default review date, otherwise null
|
|---|
| 140 | . I DGRDAT>0 D
|
|---|
| 141 | . . S DGPFA("REVIEWDT")=$$ANSWER^DGPFUT("Enter Review Date",$$FMTE^XLFDT(DGRDAT,"5D"),"D^"_DT_":"_DGRDAT_":EX")
|
|---|
| 142 | . E S DGPFA("REVIEWDT")=""
|
|---|
| 143 | . Q:DGPFA("REVIEWDT")<0
|
|---|
| 144 | . ;
|
|---|
| 145 | . ;display flag assignment review screen to user
|
|---|
| 146 | . D REVIEW^DGPFUT3(.DGPFA,.DGPFAH,"",XQY0,XQORNOD(0))
|
|---|
| 147 | . ;
|
|---|
| 148 | . Q:$$ANSWER^DGPFUT("Would you like to file this new record flag assignment","YES","Y")'>0
|
|---|
| 149 | . ;
|
|---|
| 150 | . ;file the assignment and history using STOALL api
|
|---|
| 151 | . W !,"Filing the patient's new record flag assignment..."
|
|---|
| 152 | . S DGRESULT=$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGPFERR)
|
|---|
| 153 | . W !?5,"Assignment was "_$S(+$G(DGRESULT):"filed successfully.",1:"not filed successfully.")
|
|---|
| 154 | . ;
|
|---|
| 155 | . ;send HL7 message if adding an assignment to a CAT I flag
|
|---|
| 156 | . I $G(DGRESULT),DGPFA("FLAG")["26.15",$$SNDORU^DGPFHLS(+DGRESULT) D
|
|---|
| 157 | . . W !?5,"Message sent...updating patient's sites of record."
|
|---|
| 158 | . ;
|
|---|
| 159 | . D PAUSE^VALM1
|
|---|
| 160 | . ;
|
|---|
| 161 | . ;re-build list of flag assignments for patient
|
|---|
| 162 | . D BLDLIST^DGPFLMU(DGDFN)
|
|---|
| 163 | ;
|
|---|
| 164 | S VALMBCK="R"
|
|---|
| 165 | ;
|
|---|
| 166 | Q
|
|---|
