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