- 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 Jan 18, 2025@03:47:59 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