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

DGPFAA3.m

Go to the documentation of this file.
  1. DGPFAA3 ;ALB/RPM - PRF ASSIGNMENT API'S CONTINUED ; 3/28/03
  1. ;;5.3;Registration;**425,650,911,951**;Aug 13, 1993;Build 135
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q ;no direct entry
  1. ;
  1. NOTIFYDT(DGFLG,DGRDT) ;calculate the notification date
  1. ;
  1. ; Input:
  1. ; DGFLG - (required) pointer to PRF LOCAL FLAG (#26.11) file or
  1. ; PRF NATIONAL FLAG (#26.15) file
  1. ; DGRDT - (required) review date in FM format
  1. ;
  1. ; Output:
  1. ; Function Value - notification date in FM format on success, 0 on
  1. ; failure.
  1. ;
  1. N DGFLGA ;flag file data array
  1. N DGNDT ;function value
  1. ;
  1. S DGNDT=0
  1. I $G(DGFLG)]"",+$G(DGRDT)>0 D
  1. . ;
  1. . ;Retrieve the flag data array
  1. . Q:'$$GETFLAG^DGPFUT1(DGFLG,.DGFLGA)
  1. . ;
  1. . ;must have a review frequency
  1. . Q:(+$G(DGFLGA("REVFREQ"))=0)
  1. . ;
  1. . ;determine notification date
  1. . S DGFLGA("NOTIDAYS")=$G(DGFLGA("NOTIDAYS"),0)
  1. . S DGRDT=+$$FMTH^XLFDT(DGRDT)
  1. . S DGNDT=+$$HTFM^XLFDT(DGRDT-DGFLGA("NOTIDAYS"))
  1. ;
  1. Q DGNDT
  1. ;
  1. GETRDT(DGFLG,DGADT) ;calculate the review date
  1. ;
  1. ; Input:
  1. ; DGFLG - (required) pointer to PRF LOCAL FLAG (#26.11) file or
  1. ; PRF NATIONAL FLAG (#26.15) file
  1. ; DGADT - (required) assignment date in FM format
  1. ;
  1. ; Output:
  1. ; Function Value - review date in FM format on success, 0 on failure
  1. ;
  1. N DGFLGA ;flag file data array
  1. N DGRDT ;function value
  1. ;
  1. S DGRDT=0
  1. I $G(DGFLG)]"",+$G(DGADT)>0 D
  1. . ;
  1. . ;Retrieve the flag data array
  1. . Q:'$$GETFLAG^DGPFUT1(DGFLG,.DGFLGA)
  1. . ;
  1. . ;must have a review frequency
  1. . Q:(+$G(DGFLGA("REVFREQ"))=0)
  1. . ;
  1. . ;determine review date
  1. . S DGADT=+$$FMTH^XLFDT(DGADT)
  1. . S DGRDT=+$$HTFM^XLFDT(DGADT+DGFLGA("REVFREQ"))
  1. ;
  1. Q DGRDT
  1. ;
  1. LOCK(DGAIEN) ;Lock assignment record.
  1. ;
  1. ; This function is used to prevent another process from editing a
  1. ; patient's record flag assignment.
  1. ;
  1. ; Input:
  1. ; DGAIEN - IEN of record in the PRF ASSIGNMENT (#26.13) file
  1. ;
  1. ; Output:
  1. ; Function Value - Returns 1 if the lock was successful, 0 otherwise
  1. ;
  1. I $G(DGAIEN) L +^DGPF(26.13,DGAIEN):10
  1. ;
  1. Q $T
  1. ;
  1. UNLOCK(DGAIEN) ;Unlock assignment record.
  1. ;
  1. ; This procedure is used to release the lock created by $$LOCK.
  1. ;
  1. ; Input:
  1. ; DGAIEN - IEN of record in the PRF ASSIGNMENT (#26.13) file
  1. ;
  1. ; Output: None
  1. ;
  1. I $G(DGAIEN) L -^DGPF(26.13,DGAIEN)
  1. ;
  1. Q
  1. ;
  1. STOHL7(DGPFA,DGPFAH,DGEROOT,DGPFUV) ;store a valid assignment from HL7 message
  1. ; This function files an assignment if the originating site is
  1. ; authorized to update an existing record and if the action is valid for
  1. ; the status of an existing record.
  1. ;
  1. ; Input:
  1. ; DGPFA - (required) array of assignment values to be filed (see
  1. ; $$GETASGN^DGPFAA for valid array structure)
  1. ; DGPFAH - (required) array of assignment history values to be filed
  1. ; (see $$STOHIST^DGPFAAH for valid array structure)
  1. ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
  1. ; error dialog returned from BLD^DIALOG. If not passed, error
  1. ; dialog is returned in ^TMP("DIERR",$J) global.
  1. ; DGPFUV - (optional) see STOALL^DGPFAA
  1. ;
  1. ; Output:
  1. ; Function Value - Returns 1 on success, 0 on failure
  1. ; DGEROOT() - error output array from BLD^DIALOG
  1. ;
  1. N DGDFN
  1. N DGFLG
  1. N DGORIG
  1. N DGACT
  1. N DGMSG
  1. N DGRSLT
  1. N DIERR ;var returned from BLD^DIALOG
  1. ;
  1. S DGDFN=+$G(DGPFA("DFN"))
  1. S DGFLG=$G(DGPFA("FLAG"))
  1. S DGORIG=+$G(DGPFA("SNDFAC"))
  1. S DGACT=+$G(DGPFAH("ACTION"))
  1. ;
  1. S DGRSLT=0
  1. ;
  1. D ;drops out of block on failure
  1. . ;
  1. . ;check input params
  1. . I DGDFN'>0 D BLD^DIALOG(261110,,,DGEROOT,"F") Q
  1. . I DGFLG']"" D BLD^DIALOG(261111,,,DGEROOT,"F") Q
  1. . I DGORIG'>0 D BLD^DIALOG(261125,,,DGEROOT,"F") Q
  1. . I DGACT'>0 D BLD^DIALOG(261118,,,DGEROOT,"F") Q
  1. . ;
  1. . ;new assignment action
  1. . I DGACT=1,'$$ADDOK^DGPFAA2(DGDFN,DGFLG,DGEROOT) Q
  1. . ;
  1. . ;all other actions
  1. . I DGACT'=1,'$$HL7EDTOK(DGDFN,DGFLG,DGORIG,DGACT,DGEROOT) Q
  1. . ;
  1. . ;file the assignment and history
  1. . I '$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGMSG,$G(DGPFUV))!($D(DGMSG)) D Q
  1. . . D BLD^DIALOG(261120,,,DGEROOT,"F")
  1. . ;
  1. . ;success
  1. . S DGRSLT=1
  1. ;
  1. Q DGRSLT
  1. ;
  1. HL7EDTOK(DGDFN,DGFLG,DGORIG,DGACT,DGEROOT) ;Is site allowed to edit assignment?
  1. ; This function acts as wrapper for $$EDTOK and $$ACTIONOK for edits
  1. ; that originate from PRF HL7 message processing.
  1. ;
  1. ; Supported DBIA #2171: This DBIA is used to access the KERNEL
  1. ; INSTITUTION (#4) file API PARENT^XUAF4.
  1. ;
  1. ; Input:
  1. ; DGDFN - IEN of patient in PATIENT (#2) file
  1. ; DGFLG - IEN of patient record flag in PRF NATIONAL FLAG (#26.15)
  1. ; file or PRF LOCAL FLAG (#26.11) file. [ex: "1;DGPF(26.15,"]
  1. ; DGORIG - IEN of originating site in INSTITUTION (#4) file
  1. ; DGACT - Assignment edit action in internal format
  1. ; [1:NEW ASSIGNMENT,2:CONTINUE,3:INACTIVATE,4:REACTIVATE,5:ENTERED IN ERROR]
  1. ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
  1. ; error dialog returned from BLD^DIALOG. If not passed, error
  1. ; dialog is returned in ^TMP("DIERR",$J) global.
  1. ;
  1. ; Output:
  1. ; Function value - 1 if authorized, 0 if not authorized
  1. ; DGEROOT() - error output array from BLD^DIALOG
  1. ;
  1. N DGIEN ;pointer to PRF ASSIGNMENT (#26.13) file
  1. N DGPFA ;assignment data array
  1. N DGFARRY ;flag data array
  1. N DGOWNER ;IEN of owner site in INSTITUTION (#4) file
  1. N DGRSLT ;function value
  1. N DIERR ;var returned from BLD^DIALOG
  1. ;
  1. ;init error output array if passed
  1. S DGEROOT=$G(DGEROOT)
  1. I DGEROOT]"" K @DGEROOT
  1. ;
  1. S DGACT=+$G(DGACT)
  1. S DGDFN=+$G(DGDFN)
  1. S DGFLG=$G(DGFLG)
  1. S DGORIG=+$G(DGORIG)
  1. S DGRSLT=0
  1. ;
  1. D ;drops out of block on failure
  1. . ;
  1. . ;check input params
  1. . I DGDFN'>0 D BLD^DIALOG(261110,,,DGEROOT,"F") Q
  1. . I DGACT'>0 D BLD^DIALOG(261118,,,DGEROOT,"F") Q
  1. . I DGORIG'>0 D BLD^DIALOG(261125,,,DGEROOT,"F") Q
  1. . I DGFLG']"" D BLD^DIALOG(261111,,,DGEROOT,"F") Q
  1. . ;
  1. . ;retrieve existing assignment data
  1. . S DGIEN=$$FNDASGN^DGPFAA(DGDFN,DGFLG)
  1. . I '$$GETASGN^DGPFAA(DGIEN,.DGPFA) D Q
  1. . . D BLD^DIALOG(261102,,,DGEROOT,"F")
  1. . ;
  1. . ;Patch 911, removing sending facility check, this does not allow
  1. . ;sites to process msgs from integrated sites-BG
  1. . ;SENDING FACILITY be the OWNER or parent of the OWNER
  1. . ;S DGOWNER=+$G(DGPFA("OWNER"))
  1. . ;I DGORIG'=DGOWNER,DGORIG'=+$$PARENT^DGPFUT1(DGOWNER) D Q
  1. . ;. D BLD^DIALOG(261116,,,DGEROOT,"F")
  1. . ;
  1. . ;quit if flag STATUS is INACTIVE
  1. . I $$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGFARRY)
  1. . I '+$G(DGFARRY("STAT")) D Q
  1. . . D BLD^DIALOG(261113,,,DGEROOT,"F")
  1. . ;
  1. . ;quit if no TIU PN TITLE IEN is found for the record flag
  1. . I '+$P($G(DGFARRY("TIUTITLE")),U) D Q
  1. . . D BLD^DIALOG(261114,,,DGEROOT,"F")
  1. . ;
  1. . ;ACTION must be valid for current assignment STATUS
  1. . Q:('$$ACTIONOK^DGPFAA2(.DGPFA,DGACT,DGEROOT))
  1. . ;
  1. . ;success
  1. . S DGRSLT=1
  1. ;
  1. Q DGRSLT