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

DGPFAA2.m

Go to the documentation of this file.
  1. DGPFAA2 ;ALB/KCL - PRF ASSIGNMENT API'S CONTINUED ; 3/22/05
  1. ;;5.3;Registration;**425,554,650,951**;Aug 13, 1993;Build 135
  1. ; Last Edited: SHRPE/SGM - Jul 24,2018 11:57
  1. ;
  1. ;no direct entry
  1. QUIT
  1. ;
  1. ADDOK(DGDFN,DGFLG,DGEROOT) ;This function will be used to determine if a flag may be assigned to a patient.
  1. ;
  1. ; Input:
  1. ; DGDFN - (required) IEN of patient in PATIENT (#2) file
  1. ; DGFLG - (required) IEN of patient record flag in PRF NATIONAL
  1. ; FLAG (#26.15) file or PRF LOCAL FLAG (#26.11) file
  1. ; [ex: "1;DGPF(26.15,"]
  1. ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for error
  1. ; dialog returned from BLD^DIALOG. If not passed, error
  1. ; dialog is returned in ^TMP("DIERR",$J) global.
  1. ;
  1. ; Output:
  1. ; Function Value - returns 1 on success, 0 on failure
  1. ; DGEROOT() - error output array from BLD^DIALOG
  1. ;
  1. N DGRSLT ;function result
  1. N DGFARRY ;contains flag array
  1. K DGFARRY
  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 DGRSLT=0
  1. ;
  1. D ;drops out of block on failure
  1. . ;
  1. . ;quit if DFN invalid
  1. . I '$G(DGDFN)!'$D(^DPT(+$G(DGDFN),0)) D Q
  1. . . D BLD^DIALOG(261110,,,DGEROOT,"F")
  1. . ;
  1. . ;quit if flag ien invalid
  1. . I '$$TESTVAL^DGPFUT(26.13,.02,DGFLG) D Q
  1. . . D BLD^DIALOG(261111,,,DGEROOT,"F")
  1. . ;
  1. . ;quit if flag already assigned to patient
  1. . I $$FNDASGN^DGPFAA(DGDFN,DGFLG) D Q
  1. . . D BLD^DIALOG(261112,,,DGEROOT,"F")
  1. . ;
  1. . ;quit if flag STATUS is INACTIVE
  1. . I $$GETFLAG^DGPFUT1(DGFLG,.DGFARRY),('+$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. . ;success
  1. . S DGRSLT=1
  1. ;
  1. Q DGRSLT
  1. ;
  1. EDTOK(DGPFA,DGORIG,DGEROOT) ;This function will be used to determine if a flag assignment may be edited.
  1. ;
  1. ; Input:
  1. ; DGPFA - (required) array containing the flag assignment values
  1. ; DGORIG - (optional) originating site [default = +$$SITE^VASITE()]
  1. ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
  1. ; error dialog returned from BLD^DIALOG. If not passed,
  1. ; error dialog is returned in ^TMP("DIERR",$J) global.
  1. ;
  1. ; Output:
  1. ; Function Value - returns 1 on success, 0 on failure
  1. ; DGEROOT() - error output array from BLD^DIALOG
  1. ;
  1. N DGRSLT ;function result
  1. N DGFARRY ;contains flag array
  1. K DGFARRY
  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 DGRSLT=0
  1. ;
  1. D ;drops out of block on failure
  1. . ;
  1. . ;quit if current site is not the owner site
  1. . I +$G(DGORIG)'>0 S DGORIG=+$$SITE^VASITE()
  1. . I +$G(DGPFA("OWNER"))'=DGORIG D Q
  1. . . D BLD^DIALOG(261115,,,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 is found for the record flag
  1. . I '+$P($G(DGFARRY("TIUTITLE")),U) D Q
  1. . . D BLD^DIALOG(261114,,,DGEROOT,"F")
  1. . ;
  1. . ;success
  1. . S DGRSLT=1
  1. ;
  1. Q DGRSLT
  1. ;
  1. ACTIONOK(DGPFA,DGACT,DGEROOT) ;This function will be used to verify that an assignment edit ACTION is appropriate for the current assignment STATUS.
  1. ;
  1. ; Input:
  1. ; DGPFA - (required) assignment array data from current record
  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 - returns 1 on success, 0 on failure
  1. ; DGEROOT() - error output array from BLD^DIALOG
  1. ;
  1. N DGRSLT ;function result
  1. N DGSTAT ;current assignment status
  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 DGSTAT=$P($G(DGPFA("STATUS")),U,1)
  1. S DGRSLT=0
  1. ;
  1. D ;drops out of block on failure
  1. . ;
  1. . ;is ACTION valid?
  1. . I '$$TESTVAL^DGPFUT(26.14,.03,DGACT),'DGSTAT?1N D Q
  1. . . D BLD^DIALOG(261118,,,DGEROOT,"F")
  1. . ;
  1. . ;must not CONTINUE inactive assignments
  1. . I DGACT=2,DGSTAT=0 D Q
  1. . . D BLD^DIALOG(261121,,,DGEROOT,"F")
  1. . ;
  1. . ;must not INACTIVATE inactive assignments
  1. . I DGACT=3,DGSTAT=0 D Q
  1. . . D BLD^DIALOG(261122,,,DGEROOT,"F")
  1. . ;
  1. . ;must not ENTERED IN ERROR inactive assignments
  1. . I DGACT=5,DGSTAT=0 D Q
  1. . . D BLD^DIALOG(261123,,,DGEROOT,"F")
  1. . ;
  1. . ;must not REACTIVATE active assignments
  1. . I DGACT=4,DGSTAT=1 D Q
  1. . . D BLD^DIALOG(261124,,,DGEROOT,"F")
  1. . ;
  1. . ;success
  1. . S DGRSLT=1
  1. ;
  1. Q DGRSLT
  1. ;
  1. CHGOWN(DGPFA,DGORIG,DGEROOT) ;This function is used to determine if a site is allowed to change ownership of a record flag assignment?
  1. ;
  1. ; Input:
  1. ; DGPFA - (required) array containing the flag assignment values
  1. ; DGORIG - (optional) originating site [default = +$$SITE^VASITE()]
  1. ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
  1. ; error dialog returned from BLD^DIALOG. If not passed,
  1. ; error dialog is returned in ^TMP("DIERR",$J) global.
  1. ;
  1. ; Output:
  1. ; Function Value - returns 1 on success, 0 on failure
  1. ; DGEROOT() - error output array from BLD^DIALOG
  1. ;
  1. N DGRSLT ;function result
  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:(+$G(DGORIG)'>0) DGORIG=(+$$SITE^VASITE())
  1. S DGRSLT=0
  1. ;
  1. D ;drops out of block on failure
  1. . ;
  1. . ;ORIGINATING SITE must be OWNER and flag must be ACTIVE
  1. . Q:('$$EDTOK(.DGPFA,DGORIG,.DGEROOT))
  1. . ;
  1. . ;can't CHANGE OWNERSHIP for an INACTIVE assignment
  1. . I '+$G(DGPFA("STATUS")) D Q
  1. . . D BLD^DIALOG(261117,,,DGEROOT,"F")
  1. . ;
  1. . ;success
  1. . S DGRSLT=1
  1. ;
  1. Q DGRSLT
  1. ;
  1. ROLLBACK(DGAIEN,DGPFOA) ;Roll back an assignment record
  1. ;
  1. ; Input:
  1. ; DGAIEN - IEN of assignment to roll back in the PRF ASSIGNMENT
  1. ; (#26.13) file
  1. ; DGPFOA - Assignment data array prior to record modification
  1. ;
  1. ; Output:
  1. ; Function value - 1 on successful rollback, 0 on failure
  1. ;
  1. N DGRSLT ;function result
  1. ;
  1. S DGRSLT=0
  1. I +$G(DGAIEN),$D(^DGPF(26.13,DGAIEN)),$D(DGPFOA) D
  1. . N DGIENS
  1. . S DGIENS=DGAIEN_","
  1. . I $G(DGPFOA("DFN"))="@" D
  1. . . N DGEROOT,DGFDA
  1. . . S DGFDA(26.13,DGIENS,.01)="@"
  1. . . D FILE^DIE("","DGFDA","DGEROOT")
  1. . . I '$D(DGEROOT) S DGRSLT=1
  1. . . Q
  1. . E D
  1. . . ; DG*5.3*951 - DBRS# multiple, remove all DBRS# before rollback
  1. . . D DEL^DGPFUT6(DGAIEN,26.13)
  1. . . I $$STOASGN^DGPFAA(.DGPFOA,.DGEROOT,1),'$D(DGEROOT) S DGRSLT=1
  1. . . Q
  1. . Q
  1. Q DGRSLT