DGPFAA3 ;ALB/RPM - PRF ASSIGNMENT API'S CONTINUED ; 3/28/03
;;5.3;Registration;**425,650,911,951**;Aug 13, 1993;Build 135
;;Per VA Directive 6402, this routine should not be modified.
;
Q ;no direct entry
;
NOTIFYDT(DGFLG,DGRDT) ;calculate the notification date
;
; Input:
; DGFLG - (required) pointer to PRF LOCAL FLAG (#26.11) file or
; PRF NATIONAL FLAG (#26.15) file
; DGRDT - (required) review date in FM format
;
; Output:
; Function Value - notification date in FM format on success, 0 on
; failure.
;
N DGFLGA ;flag file data array
N DGNDT ;function value
;
S DGNDT=0
I $G(DGFLG)]"",+$G(DGRDT)>0 D
. ;
. ;Retrieve the flag data array
. Q:'$$GETFLAG^DGPFUT1(DGFLG,.DGFLGA)
. ;
. ;must have a review frequency
. Q:(+$G(DGFLGA("REVFREQ"))=0)
. ;
. ;determine notification date
. S DGFLGA("NOTIDAYS")=$G(DGFLGA("NOTIDAYS"),0)
. S DGRDT=+$$FMTH^XLFDT(DGRDT)
. S DGNDT=+$$HTFM^XLFDT(DGRDT-DGFLGA("NOTIDAYS"))
;
Q DGNDT
;
GETRDT(DGFLG,DGADT) ;calculate the review date
;
; Input:
; DGFLG - (required) pointer to PRF LOCAL FLAG (#26.11) file or
; PRF NATIONAL FLAG (#26.15) file
; DGADT - (required) assignment date in FM format
;
; Output:
; Function Value - review date in FM format on success, 0 on failure
;
N DGFLGA ;flag file data array
N DGRDT ;function value
;
S DGRDT=0
I $G(DGFLG)]"",+$G(DGADT)>0 D
. ;
. ;Retrieve the flag data array
. Q:'$$GETFLAG^DGPFUT1(DGFLG,.DGFLGA)
. ;
. ;must have a review frequency
. Q:(+$G(DGFLGA("REVFREQ"))=0)
. ;
. ;determine review date
. S DGADT=+$$FMTH^XLFDT(DGADT)
. S DGRDT=+$$HTFM^XLFDT(DGADT+DGFLGA("REVFREQ"))
;
Q DGRDT
;
LOCK(DGAIEN) ;Lock assignment record.
;
; This function is used to prevent another process from editing a
; patient's record flag assignment.
;
; Input:
; DGAIEN - IEN of record in the PRF ASSIGNMENT (#26.13) file
;
; Output:
; Function Value - Returns 1 if the lock was successful, 0 otherwise
;
I $G(DGAIEN) L +^DGPF(26.13,DGAIEN):10
;
Q $T
;
UNLOCK(DGAIEN) ;Unlock assignment record.
;
; This procedure is used to release the lock created by $$LOCK.
;
; Input:
; DGAIEN - IEN of record in the PRF ASSIGNMENT (#26.13) file
;
; Output: None
;
I $G(DGAIEN) L -^DGPF(26.13,DGAIEN)
;
Q
;
STOHL7(DGPFA,DGPFAH,DGEROOT,DGPFUV) ;store a valid assignment from HL7 message
; This function files an assignment if the originating site is
; authorized to update an existing record and if the action is valid for
; the status of an existing record.
;
; Input:
; DGPFA - (required) array of assignment values to be filed (see
; $$GETASGN^DGPFAA for valid array structure)
; DGPFAH - (required) array of assignment history values to be filed
; (see $$STOHIST^DGPFAAH for valid array structure)
; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
; error dialog returned from BLD^DIALOG. If not passed, error
; dialog is returned in ^TMP("DIERR",$J) global.
; DGPFUV - (optional) see STOALL^DGPFAA
;
; Output:
; Function Value - Returns 1 on success, 0 on failure
; DGEROOT() - error output array from BLD^DIALOG
;
N DGDFN
N DGFLG
N DGORIG
N DGACT
N DGMSG
N DGRSLT
N DIERR ;var returned from BLD^DIALOG
;
S DGDFN=+$G(DGPFA("DFN"))
S DGFLG=$G(DGPFA("FLAG"))
S DGORIG=+$G(DGPFA("SNDFAC"))
S DGACT=+$G(DGPFAH("ACTION"))
;
S DGRSLT=0
;
D ;drops out of block on failure
. ;
. ;check input params
. I DGDFN'>0 D BLD^DIALOG(261110,,,DGEROOT,"F") Q
. I DGFLG']"" D BLD^DIALOG(261111,,,DGEROOT,"F") Q
. I DGORIG'>0 D BLD^DIALOG(261125,,,DGEROOT,"F") Q
. I DGACT'>0 D BLD^DIALOG(261118,,,DGEROOT,"F") Q
. ;
. ;new assignment action
. I DGACT=1,'$$ADDOK^DGPFAA2(DGDFN,DGFLG,DGEROOT) Q
. ;
. ;all other actions
. I DGACT'=1,'$$HL7EDTOK(DGDFN,DGFLG,DGORIG,DGACT,DGEROOT) Q
. ;
. ;file the assignment and history
. I '$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGMSG,$G(DGPFUV))!($D(DGMSG)) D Q
. . D BLD^DIALOG(261120,,,DGEROOT,"F")
. ;
. ;success
. S DGRSLT=1
;
Q DGRSLT
;
HL7EDTOK(DGDFN,DGFLG,DGORIG,DGACT,DGEROOT) ;Is site allowed to edit assignment?
; This function acts as wrapper for $$EDTOK and $$ACTIONOK for edits
; that originate from PRF HL7 message processing.
;
; Supported DBIA #2171: This DBIA is used to access the KERNEL
; INSTITUTION (#4) file API PARENT^XUAF4.
;
; Input:
; DGDFN - IEN of patient in PATIENT (#2) file
; DGFLG - IEN of patient record flag in PRF NATIONAL FLAG (#26.15)
; file or PRF LOCAL FLAG (#26.11) file. [ex: "1;DGPF(26.15,"]
; DGORIG - IEN of originating site in INSTITUTION (#4) file
; DGACT - Assignment edit action in internal format
; [1:NEW ASSIGNMENT,2:CONTINUE,3:INACTIVATE,4:REACTIVATE,5:ENTERED IN ERROR]
; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
; error dialog returned from BLD^DIALOG. If not passed, error
; dialog is returned in ^TMP("DIERR",$J) global.
;
; Output:
; Function value - 1 if authorized, 0 if not authorized
; DGEROOT() - error output array from BLD^DIALOG
;
N DGIEN ;pointer to PRF ASSIGNMENT (#26.13) file
N DGPFA ;assignment data array
N DGFARRY ;flag data array
N DGOWNER ;IEN of owner site in INSTITUTION (#4) file
N DGRSLT ;function value
N DIERR ;var returned from BLD^DIALOG
;
;init error output array if passed
S DGEROOT=$G(DGEROOT)
I DGEROOT]"" K @DGEROOT
;
S DGACT=+$G(DGACT)
S DGDFN=+$G(DGDFN)
S DGFLG=$G(DGFLG)
S DGORIG=+$G(DGORIG)
S DGRSLT=0
;
D ;drops out of block on failure
. ;
. ;check input params
. I DGDFN'>0 D BLD^DIALOG(261110,,,DGEROOT,"F") Q
. I DGACT'>0 D BLD^DIALOG(261118,,,DGEROOT,"F") Q
. I DGORIG'>0 D BLD^DIALOG(261125,,,DGEROOT,"F") Q
. I DGFLG']"" D BLD^DIALOG(261111,,,DGEROOT,"F") Q
. ;
. ;retrieve existing assignment data
. S DGIEN=$$FNDASGN^DGPFAA(DGDFN,DGFLG)
. I '$$GETASGN^DGPFAA(DGIEN,.DGPFA) D Q
. . D BLD^DIALOG(261102,,,DGEROOT,"F")
. ;
. ;Patch 911, removing sending facility check, this does not allow
. ;sites to process msgs from integrated sites-BG
. ;SENDING FACILITY be the OWNER or parent of the OWNER
. ;S DGOWNER=+$G(DGPFA("OWNER"))
. ;I DGORIG'=DGOWNER,DGORIG'=+$$PARENT^DGPFUT1(DGOWNER) D Q
. ;. D BLD^DIALOG(261116,,,DGEROOT,"F")
. ;
. ;quit if flag STATUS is INACTIVE
. I $$GETFLAG^DGPFUT1($P($G(DGPFA("FLAG")),U),.DGFARRY)
. I '+$G(DGFARRY("STAT")) D Q
. . D BLD^DIALOG(261113,,,DGEROOT,"F")
. ;
. ;quit if no TIU PN TITLE IEN is found for the record flag
. I '+$P($G(DGFARRY("TIUTITLE")),U) D Q
. . D BLD^DIALOG(261114,,,DGEROOT,"F")
. ;
. ;ACTION must be valid for current assignment STATUS
. Q:('$$ACTIONOK^DGPFAA2(.DGPFA,DGACT,DGEROOT))
. ;
. ;success
. S DGRSLT=1
;
Q DGRSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFAA3 7084 printed Apr 09, 2024@22:00:34 Page 2
DGPFAA3 ;ALB/RPM - PRF ASSIGNMENT API'S CONTINUED ; 3/28/03
+1 ;;5.3;Registration;**425,650,911,951**;Aug 13, 1993;Build 135
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;no direct entry
QUIT
+5 ;
NOTIFYDT(DGFLG,DGRDT) ;calculate the notification date
+1 ;
+2 ; Input:
+3 ; DGFLG - (required) pointer to PRF LOCAL FLAG (#26.11) file or
+4 ; PRF NATIONAL FLAG (#26.15) file
+5 ; DGRDT - (required) review date in FM format
+6 ;
+7 ; Output:
+8 ; Function Value - notification date in FM format on success, 0 on
+9 ; failure.
+10 ;
+11 ;flag file data array
NEW DGFLGA
+12 ;function value
NEW DGNDT
+13 ;
+14 SET DGNDT=0
+15 IF $GET(DGFLG)]""
IF +$GET(DGRDT)>0
Begin DoDot:1
+16 ;
+17 ;Retrieve the flag data array
+18 if '$$GETFLAG^DGPFUT1(DGFLG,.DGFLGA)
QUIT
+19 ;
+20 ;must have a review frequency
+21 if (+$GET(DGFLGA("REVFREQ"))=0)
QUIT
+22 ;
+23 ;determine notification date
+24 SET DGFLGA("NOTIDAYS")=$GET(DGFLGA("NOTIDAYS"),0)
+25 SET DGRDT=+$$FMTH^XLFDT(DGRDT)
+26 SET DGNDT=+$$HTFM^XLFDT(DGRDT-DGFLGA("NOTIDAYS"))
End DoDot:1
+27 ;
+28 QUIT DGNDT
+29 ;
GETRDT(DGFLG,DGADT) ;calculate the review date
+1 ;
+2 ; Input:
+3 ; DGFLG - (required) pointer to PRF LOCAL FLAG (#26.11) file or
+4 ; PRF NATIONAL FLAG (#26.15) file
+5 ; DGADT - (required) assignment date in FM format
+6 ;
+7 ; Output:
+8 ; Function Value - review date in FM format on success, 0 on failure
+9 ;
+10 ;flag file data array
NEW DGFLGA
+11 ;function value
NEW DGRDT
+12 ;
+13 SET DGRDT=0
+14 IF $GET(DGFLG)]""
IF +$GET(DGADT)>0
Begin DoDot:1
+15 ;
+16 ;Retrieve the flag data array
+17 if '$$GETFLAG^DGPFUT1(DGFLG,.DGFLGA)
QUIT
+18 ;
+19 ;must have a review frequency
+20 if (+$GET(DGFLGA("REVFREQ"))=0)
QUIT
+21 ;
+22 ;determine review date
+23 SET DGADT=+$$FMTH^XLFDT(DGADT)
+24 SET DGRDT=+$$HTFM^XLFDT(DGADT+DGFLGA("REVFREQ"))
End DoDot:1
+25 ;
+26 QUIT DGRDT
+27 ;
LOCK(DGAIEN) ;Lock assignment record.
+1 ;
+2 ; This function is used to prevent another process from editing a
+3 ; patient's record flag assignment.
+4 ;
+5 ; Input:
+6 ; DGAIEN - IEN of record in the PRF ASSIGNMENT (#26.13) file
+7 ;
+8 ; Output:
+9 ; Function Value - Returns 1 if the lock was successful, 0 otherwise
+10 ;
+11 IF $GET(DGAIEN)
LOCK +^DGPF(26.13,DGAIEN):10
+12 ;
+13 QUIT $TEST
+14 ;
UNLOCK(DGAIEN) ;Unlock assignment record.
+1 ;
+2 ; This procedure is used to release the lock created by $$LOCK.
+3 ;
+4 ; Input:
+5 ; DGAIEN - IEN of record in the PRF ASSIGNMENT (#26.13) file
+6 ;
+7 ; Output: None
+8 ;
+9 IF $GET(DGAIEN)
LOCK -^DGPF(26.13,DGAIEN)
+10 ;
+11 QUIT
+12 ;
STOHL7(DGPFA,DGPFAH,DGEROOT,DGPFUV) ;store a valid assignment from HL7 message
+1 ; This function files an assignment if the originating site is
+2 ; authorized to update an existing record and if the action is valid for
+3 ; the status of an existing record.
+4 ;
+5 ; Input:
+6 ; DGPFA - (required) array of assignment values to be filed (see
+7 ; $$GETASGN^DGPFAA for valid array structure)
+8 ; DGPFAH - (required) array of assignment history values to be filed
+9 ; (see $$STOHIST^DGPFAAH for valid array structure)
+10 ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
+11 ; error dialog returned from BLD^DIALOG. If not passed, error
+12 ; dialog is returned in ^TMP("DIERR",$J) global.
+13 ; DGPFUV - (optional) see STOALL^DGPFAA
+14 ;
+15 ; Output:
+16 ; Function Value - Returns 1 on success, 0 on failure
+17 ; DGEROOT() - error output array from BLD^DIALOG
+18 ;
+19 NEW DGDFN
+20 NEW DGFLG
+21 NEW DGORIG
+22 NEW DGACT
+23 NEW DGMSG
+24 NEW DGRSLT
+25 ;var returned from BLD^DIALOG
NEW DIERR
+26 ;
+27 SET DGDFN=+$GET(DGPFA("DFN"))
+28 SET DGFLG=$GET(DGPFA("FLAG"))
+29 SET DGORIG=+$GET(DGPFA("SNDFAC"))
+30 SET DGACT=+$GET(DGPFAH("ACTION"))
+31 ;
+32 SET DGRSLT=0
+33 ;
+34 ;drops out of block on failure
Begin DoDot:1
+35 ;
+36 ;check input params
+37 IF DGDFN'>0
DO BLD^DIALOG(261110,,,DGEROOT,"F")
QUIT
+38 IF DGFLG']""
DO BLD^DIALOG(261111,,,DGEROOT,"F")
QUIT
+39 IF DGORIG'>0
DO BLD^DIALOG(261125,,,DGEROOT,"F")
QUIT
+40 IF DGACT'>0
DO BLD^DIALOG(261118,,,DGEROOT,"F")
QUIT
+41 ;
+42 ;new assignment action
+43 IF DGACT=1
IF '$$ADDOK^DGPFAA2(DGDFN,DGFLG,DGEROOT)
QUIT
+44 ;
+45 ;all other actions
+46 IF DGACT'=1
IF '$$HL7EDTOK(DGDFN,DGFLG,DGORIG,DGACT,DGEROOT)
QUIT
+47 ;
+48 ;file the assignment and history
+49 IF '$$STOALL^DGPFAA(.DGPFA,.DGPFAH,.DGMSG,$GET(DGPFUV))!($DATA(DGMSG))
Begin DoDot:2
+50 DO BLD^DIALOG(261120,,,DGEROOT,"F")
End DoDot:2
QUIT
+51 ;
+52 ;success
+53 SET DGRSLT=1
End DoDot:1
+54 ;
+55 QUIT DGRSLT
+56 ;
HL7EDTOK(DGDFN,DGFLG,DGORIG,DGACT,DGEROOT) ;Is site allowed to edit assignment?
+1 ; This function acts as wrapper for $$EDTOK and $$ACTIONOK for edits
+2 ; that originate from PRF HL7 message processing.
+3 ;
+4 ; Supported DBIA #2171: This DBIA is used to access the KERNEL
+5 ; INSTITUTION (#4) file API PARENT^XUAF4.
+6 ;
+7 ; Input:
+8 ; DGDFN - IEN of patient in PATIENT (#2) file
+9 ; DGFLG - IEN of patient record flag in PRF NATIONAL FLAG (#26.15)
+10 ; file or PRF LOCAL FLAG (#26.11) file. [ex: "1;DGPF(26.15,"]
+11 ; DGORIG - IEN of originating site in INSTITUTION (#4) file
+12 ; DGACT - Assignment edit action in internal format
+13 ; [1:NEW ASSIGNMENT,2:CONTINUE,3:INACTIVATE,4:REACTIVATE,5:ENTERED IN ERROR]
+14 ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
+15 ; error dialog returned from BLD^DIALOG. If not passed, error
+16 ; dialog is returned in ^TMP("DIERR",$J) global.
+17 ;
+18 ; Output:
+19 ; Function value - 1 if authorized, 0 if not authorized
+20 ; DGEROOT() - error output array from BLD^DIALOG
+21 ;
+22 ;pointer to PRF ASSIGNMENT (#26.13) file
NEW DGIEN
+23 ;assignment data array
NEW DGPFA
+24 ;flag data array
NEW DGFARRY
+25 ;IEN of owner site in INSTITUTION (#4) file
NEW DGOWNER
+26 ;function value
NEW DGRSLT
+27 ;var returned from BLD^DIALOG
NEW DIERR
+28 ;
+29 ;init error output array if passed
+30 SET DGEROOT=$GET(DGEROOT)
+31 IF DGEROOT]""
KILL @DGEROOT
+32 ;
+33 SET DGACT=+$GET(DGACT)
+34 SET DGDFN=+$GET(DGDFN)
+35 SET DGFLG=$GET(DGFLG)
+36 SET DGORIG=+$GET(DGORIG)
+37 SET DGRSLT=0
+38 ;
+39 ;drops out of block on failure
Begin DoDot:1
+40 ;
+41 ;check input params
+42 IF DGDFN'>0
DO BLD^DIALOG(261110,,,DGEROOT,"F")
QUIT
+43 IF DGACT'>0
DO BLD^DIALOG(261118,,,DGEROOT,"F")
QUIT
+44 IF DGORIG'>0
DO BLD^DIALOG(261125,,,DGEROOT,"F")
QUIT
+45 IF DGFLG']""
DO BLD^DIALOG(261111,,,DGEROOT,"F")
QUIT
+46 ;
+47 ;retrieve existing assignment data
+48 SET DGIEN=$$FNDASGN^DGPFAA(DGDFN,DGFLG)
+49 IF '$$GETASGN^DGPFAA(DGIEN,.DGPFA)
Begin DoDot:2
+50 DO BLD^DIALOG(261102,,,DGEROOT,"F")
End DoDot:2
QUIT
+51 ;
+52 ;Patch 911, removing sending facility check, this does not allow
+53 ;sites to process msgs from integrated sites-BG
+54 ;SENDING FACILITY be the OWNER or parent of the OWNER
+55 ;S DGOWNER=+$G(DGPFA("OWNER"))
+56 ;I DGORIG'=DGOWNER,DGORIG'=+$$PARENT^DGPFUT1(DGOWNER) D Q
+57 ;. D BLD^DIALOG(261116,,,DGEROOT,"F")
+58 ;
+59 ;quit if flag STATUS is INACTIVE
+60 IF $$GETFLAG^DGPFUT1($PIECE($GET(DGPFA("FLAG")),U),.DGFARRY)
+61 IF '+$GET(DGFARRY("STAT"))
Begin DoDot:2
+62 DO BLD^DIALOG(261113,,,DGEROOT,"F")
End DoDot:2
QUIT
+63 ;
+64 ;quit if no TIU PN TITLE IEN is found for the record flag
+65 IF '+$PIECE($GET(DGFARRY("TIUTITLE")),U)
Begin DoDot:2
+66 DO BLD^DIALOG(261114,,,DGEROOT,"F")
End DoDot:2
QUIT
+67 ;
+68 ;ACTION must be valid for current assignment STATUS
+69 if ('$$ACTIONOK^DGPFAA2(.DGPFA,DGACT,DGEROOT))
QUIT
+70 ;
+71 ;success
+72 SET DGRSLT=1
End DoDot:1
+73 ;
+74 QUIT DGRSLT
