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

DGPFLMA2.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;ihs/cmi/maw 07/26/2012 PATCH 1015 not using MPI check for PRF in IHS yet
  1.  ;no direct entry
  1.  QUIT
  1.  ;
  1. AF ;Entry point for DGPF ASSIGN FLAG action protocol.
  1.  ;
  1.  ;  Input:
  1.  ;     DGDFN - pointer to patient in PATIENT (#2) file
  1.  ;
  1.  ; Output:
  1.  ;   VALMBCK - 'R' = refresh screen
  1.  ;
  1.  N DIC,DGWPROOT,DIWETXT,DIWESUB,DWLW,DWPK  ;input vars for EN^DIWE call
  1.  N DGABORT   ;abort flag for entering assignment narrative
  1.  N DGFAC     ;pointer to INSTITUTION (#4) file
  1.  N DGOK      ;ok flag for entering assignment narrative
  1.  N DGPFA     ;assignment array
  1.  N DGPFAH    ;assignment history array
  1.  N DGRDAT    ;results of review date calculation
  1.  N DGRESULT  ;result of STOALL api call
  1.  N DGERR     ;if unable to add assignment
  1.  N DGPFERR   ;if error returned from STOALL
  1.  ;
  1.  ;set screen to full scroll region
  1.  D FULL^VALM1
  1.  ;
  1.  ;quit if patient not selected
  1.  I '$G(DGDFN) D  Q
  1.  . D BLD^DIALOG(261129,"Patient has not been selected.","","DGERR","F")
  1.  . D MSG^DIALOG("WE","","","","DGERR") W *7
  1.  . D PAUSE^VALM1
  1.  . S VALMBCK="R"
  1.  ;
  1.  ;is user's DUZ(2) an enabled Division for PRF ASSIGNMENT OWNERSHIP
  1.  I '$D(^DG(40.8,"APRF",+$G(DUZ(2)))) D  Q
  1.  . D BLD^DIALOG(261129,"Your Division, "_$$STA^XUAF4($G(DUZ(2)))_", is not enabled for PRF Assignment Ownership.","","DGERR","F")
  1.  . D MSG^DIALOG("WE","","","","DGERR") W *7
  1.  . D PAUSE^VALM1
  1.  . S VALMBCK="R"
  1.  ;
  1.  D  ;drops out of DO block on assignment failure
  1.  . ;
  1.  . ;init assignment and history arrays
  1.  . K DGPFA,DGPFAH
  1.  . ;
  1.  . ;get patient DFN into assignment array
  1.  . S DGPFA("DFN")=$G(DGDFN)
  1.  . Q:'DGPFA("DFN")
  1.  . ;
  1.  . ;select flag for assignment
  1.  . S DGPFA("FLAG")=$$ANSWER^DGPFUT("Select a flag for this assignment","","26.13,.02")
  1.  . Q:(DGPFA("FLAG")'>0)
  1.  . ;
  1.  . ;National ICN when Cat I assignment?
  1.  . ;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
  1.  . ;. W !!,"Unable to proceed with flag assignment..."
  1.  . ;. D BLD^DIALOG(261132,"","","DGERR","F")
  1.  . ;. D MSG^DIALOG("WE","","","","DGERR") W *7
  1.  . ;. D PAUSE^VALM1
  1.  . ;
  1.  . ;run query for Cat I assignments
  1.  . I $P(DGPFA("FLAG"),U)["26.15",$$GETSTAT^DGPFHLL1(DGDFN)'="C" D
  1.  . . N DGDIFF    ;difference between pre and post query count
  1.  . . N DGFLGCNT  ;total count of Cat I flags
  1.  . . N DGPRECNT  ;pre-query count of Cat I assignments
  1.  . . N DGPSTCNT  ;post-query count of Cat I assignments
  1.  . . ;
  1.  . . ;get count of current assignments
  1.  . . S (DGPRECNT,DGPSTCNT)=$$GETALL^DGPFAA(DGDFN,,,1)
  1.  . . ;
  1.  . . ;get total count of possible Category I flags
  1.  . . S DGFLGCNT=$$CNTRECS^DGPFUT1(26.15)
  1.  . . ;
  1.  . . ;stop if all flags are assigned
  1.  . . Q:DGPRECNT=DGFLGCNT
  1.  . . ;
  1.  . . ;execute the query...stop on failure
  1.  . . Q:'$$SNDQRY^DGPFHLS(DGDFN,1,.DGFAC)
  1.  . . ;
  1.  . . ;recheck current assignment count
  1.  . . S DGPSTCNT=$$GETALL^DGPFAA(DGDFN,,,1)
  1.  . . S DGDIFF=DGPSTCNT-DGPRECNT
  1.  . . W !!,"    ",$S(DGDIFF=1:"A ",DGDIFF>1:"",1:"No ")_"Category I patient record flag assignment"_$S(DGDIFF>1!('DGDIFF):"s were",1:" was")_" returned"
  1.  . . W !,"    from "_$P($$NS^XUAF4($G(DGFAC)),U)_$S(DGDIFF:" and filed on your system.",1:".")
  1.  . . W !
  1.  . . ;
  1.  . . ;re-build list when flag assignments have been added
  1.  . . I DGDIFF D BLDLIST^DGPFLMU(DGDFN)
  1.  . ;
  1.  . ;ok to add new assignment?
  1.  . I '$$ADDOK^DGPFAA2(DGPFA("DFN"),$P(DGPFA("FLAG"),U),"DGERR") D  Q
  1.  . . W !!,"Unable to proceed with flag assignment..."
  1.  . . D MSG^DIALOG("WE","","",5,"DGERR")
  1.  . . D PAUSE^VALM1
  1.  . ;
  1.  . ;prompt for owner site
  1.  . 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)")
  1.  . Q:(DGPFA("OWNER")'>0)
  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 assignment narrative text (required)
  1.  . S (DGABORT,DGOK)=0
  1.  . S DGWPROOT=$NA(^TMP($J,"DGPFNARR"))
  1.  . K @DGWPROOT
  1.  . F  D  Q:(DGOK!DGABORT)
  1.  . . W !!,"Enter Narrative Text for this record flag assignment:" ;needed for line editor
  1.  . . S DIC=$$OREF^DILF(DGWPROOT)
  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(DGWPROOT) S DGOK=1 Q
  1.  . . W !,"Assignment Narrative Text is required!",*7
  1.  . . I '$$CONTINUE^DGPFUT() S DGABORT=1
  1.  . . ;
  1.  . ;quit if required assignment narrative not entered
  1.  . Q:$G(DGABORT)
  1.  . ;
  1.  . ;place assignment narrative text into assignment array
  1.  . M DGPFA("NARR")=@DGWPROOT K @DGWPROOT
  1.  . ;
  1.  . ;setup remaining assignment and history array nodes for filing
  1.  . S DGPFA("STATUS")=1  ;active
  1.  . S DGPFA("ORIGSITE")=DUZ(2)  ;current user's login site
  1.  . S DGPFAH("ASSIGNDT")=$$NOW^XLFDT()  ;current date/time
  1.  . S DGPFAH("ACTION")=1  ;new assignment
  1.  . S DGPFAH("ENTERBY")=DUZ  ;current user
  1.  . S DGPFAH("COMMENT",1,0)="New record flag assignment."
  1.  . ;
  1.  . ;calculate the default review date
  1.  . S DGRDAT=$$GETRDT^DGPFAA3($P(DGPFA("FLAG"),U),DGPFAH("ASSIGNDT"))
  1.  . ;
  1.  . ;prompt for review date on valid default review date, otherwise null
  1.  . I DGRDAT>0 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,"",XQY0,XQORNOD(0))
  1.  . ;
  1.  . Q:$$ANSWER^DGPFUT("Would you like to file this new record flag assignment","YES","Y")'>0
  1.  . ;
  1.  . ;file the assignment and history using STOALL api
  1.  . W !,"Filing the patient's new 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 adding an 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.  S VALMBCK="R"
  1.  ;
  1.  Q