DGPFAA2 ;ALB/KCL - PRF ASSIGNMENT API'S CONTINUED ; 3/22/05
;;5.3;Registration;**425,554,650,951**;Aug 13, 1993;Build 135
; Last Edited: SHRPE/SGM - Jul 24,2018 11:57
;
;no direct entry
QUIT
;
ADDOK(DGDFN,DGFLG,DGEROOT) ;This function will be used to determine if a flag may be assigned to a patient.
;
; Input:
; DGDFN - (required) IEN of patient in PATIENT (#2) file
; DGFLG - (required) IEN of patient record flag in PRF NATIONAL
; FLAG (#26.15) file or PRF LOCAL FLAG (#26.11) file
; [ex: "1;DGPF(26.15,"]
; 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 - returns 1 on success, 0 on failure
; DGEROOT() - error output array from BLD^DIALOG
;
N DGRSLT ;function result
N DGFARRY ;contains flag array
K DGFARRY
N DIERR ;var returned from BLD^DIALOG
;
;init error output array if passed
S DGEROOT=$G(DGEROOT)
I DGEROOT]"" K @DGEROOT
;
S DGRSLT=0
;
D ;drops out of block on failure
. ;
. ;quit if DFN invalid
. I '$G(DGDFN)!'$D(^DPT(+$G(DGDFN),0)) D Q
. . D BLD^DIALOG(261110,,,DGEROOT,"F")
. ;
. ;quit if flag ien invalid
. I '$$TESTVAL^DGPFUT(26.13,.02,DGFLG) D Q
. . D BLD^DIALOG(261111,,,DGEROOT,"F")
. ;
. ;quit if flag already assigned to patient
. I $$FNDASGN^DGPFAA(DGDFN,DGFLG) D Q
. . D BLD^DIALOG(261112,,,DGEROOT,"F")
. ;
. ;quit if flag STATUS is INACTIVE
. I $$GETFLAG^DGPFUT1(DGFLG,.DGFARRY),('+$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")
. ;
. ;success
. S DGRSLT=1
;
Q DGRSLT
;
EDTOK(DGPFA,DGORIG,DGEROOT) ;This function will be used to determine if a flag assignment may be edited.
;
; Input:
; DGPFA - (required) array containing the flag assignment values
; DGORIG - (optional) originating site [default = +$$SITE^VASITE()]
; 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 - returns 1 on success, 0 on failure
; DGEROOT() - error output array from BLD^DIALOG
;
N DGRSLT ;function result
N DGFARRY ;contains flag array
K DGFARRY
N DIERR ;var returned from BLD^DIALOG
;
;init error output array if passed
S DGEROOT=$G(DGEROOT)
I DGEROOT]"" K @DGEROOT
;
S DGRSLT=0
;
D ;drops out of block on failure
. ;
. ;quit if current site is not the owner site
. I +$G(DGORIG)'>0 S DGORIG=+$$SITE^VASITE()
. I +$G(DGPFA("OWNER"))'=DGORIG D Q
. . D BLD^DIALOG(261115,,,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 is found for the record flag
. I '+$P($G(DGFARRY("TIUTITLE")),U) D Q
. . D BLD^DIALOG(261114,,,DGEROOT,"F")
. ;
. ;success
. S DGRSLT=1
;
Q DGRSLT
;
ACTIONOK(DGPFA,DGACT,DGEROOT) ;This function will be used to verify that an assignment edit ACTION is appropriate for the current assignment STATUS.
;
; Input:
; DGPFA - (required) assignment array data from current record
; 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 - returns 1 on success, 0 on failure
; DGEROOT() - error output array from BLD^DIALOG
;
N DGRSLT ;function result
N DGSTAT ;current assignment status
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 DGSTAT=$P($G(DGPFA("STATUS")),U,1)
S DGRSLT=0
;
D ;drops out of block on failure
. ;
. ;is ACTION valid?
. I '$$TESTVAL^DGPFUT(26.14,.03,DGACT),'DGSTAT?1N D Q
. . D BLD^DIALOG(261118,,,DGEROOT,"F")
. ;
. ;must not CONTINUE inactive assignments
. I DGACT=2,DGSTAT=0 D Q
. . D BLD^DIALOG(261121,,,DGEROOT,"F")
. ;
. ;must not INACTIVATE inactive assignments
. I DGACT=3,DGSTAT=0 D Q
. . D BLD^DIALOG(261122,,,DGEROOT,"F")
. ;
. ;must not ENTERED IN ERROR inactive assignments
. I DGACT=5,DGSTAT=0 D Q
. . D BLD^DIALOG(261123,,,DGEROOT,"F")
. ;
. ;must not REACTIVATE active assignments
. I DGACT=4,DGSTAT=1 D Q
. . D BLD^DIALOG(261124,,,DGEROOT,"F")
. ;
. ;success
. S DGRSLT=1
;
Q DGRSLT
;
CHGOWN(DGPFA,DGORIG,DGEROOT) ;This function is used to determine if a site is allowed to change ownership of a record flag assignment?
;
; Input:
; DGPFA - (required) array containing the flag assignment values
; DGORIG - (optional) originating site [default = +$$SITE^VASITE()]
; 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 - returns 1 on success, 0 on failure
; DGEROOT() - error output array from BLD^DIALOG
;
N DGRSLT ;function result
N DIERR ;var returned from BLD^DIALOG
;
;init error output array if passed
S DGEROOT=$G(DGEROOT)
I DGEROOT]"" K @DGEROOT
;
S:(+$G(DGORIG)'>0) DGORIG=(+$$SITE^VASITE())
S DGRSLT=0
;
D ;drops out of block on failure
. ;
. ;ORIGINATING SITE must be OWNER and flag must be ACTIVE
. Q:('$$EDTOK(.DGPFA,DGORIG,.DGEROOT))
. ;
. ;can't CHANGE OWNERSHIP for an INACTIVE assignment
. I '+$G(DGPFA("STATUS")) D Q
. . D BLD^DIALOG(261117,,,DGEROOT,"F")
. ;
. ;success
. S DGRSLT=1
;
Q DGRSLT
;
ROLLBACK(DGAIEN,DGPFOA) ;Roll back an assignment record
;
; Input:
; DGAIEN - IEN of assignment to roll back in the PRF ASSIGNMENT
; (#26.13) file
; DGPFOA - Assignment data array prior to record modification
;
; Output:
; Function value - 1 on successful rollback, 0 on failure
;
N DGRSLT ;function result
;
S DGRSLT=0
I +$G(DGAIEN),$D(^DGPF(26.13,DGAIEN)),$D(DGPFOA) D
. N DGIENS
. S DGIENS=DGAIEN_","
. I $G(DGPFOA("DFN"))="@" D
. . N DGEROOT,DGFDA
. . S DGFDA(26.13,DGIENS,.01)="@"
. . D FILE^DIE("","DGFDA","DGEROOT")
. . I '$D(DGEROOT) S DGRSLT=1
. . Q
. E D
. . ; DG*5.3*951 - DBRS# multiple, remove all DBRS# before rollback
. . D DEL^DGPFUT6(DGAIEN,26.13)
. . I $$STOASGN^DGPFAA(.DGPFOA,.DGEROOT,1),'$D(DGEROOT) S DGRSLT=1
. . Q
. Q
Q DGRSLT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFAA2 7077 printed Dec 13, 2024@02:47:17 Page 2
DGPFAA2 ;ALB/KCL - PRF ASSIGNMENT API'S CONTINUED ; 3/22/05
+1 ;;5.3;Registration;**425,554,650,951**;Aug 13, 1993;Build 135
+2 ; Last Edited: SHRPE/SGM - Jul 24,2018 11:57
+3 ;
+4 ;no direct entry
+5 QUIT
+6 ;
ADDOK(DGDFN,DGFLG,DGEROOT) ;This function will be used to determine if a flag may be assigned to a patient.
+1 ;
+2 ; Input:
+3 ; DGDFN - (required) IEN of patient in PATIENT (#2) file
+4 ; DGFLG - (required) IEN of patient record flag in PRF NATIONAL
+5 ; FLAG (#26.15) file or PRF LOCAL FLAG (#26.11) file
+6 ; [ex: "1;DGPF(26.15,"]
+7 ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for error
+8 ; dialog returned from BLD^DIALOG. If not passed, error
+9 ; dialog is returned in ^TMP("DIERR",$J) global.
+10 ;
+11 ; Output:
+12 ; Function Value - returns 1 on success, 0 on failure
+13 ; DGEROOT() - error output array from BLD^DIALOG
+14 ;
+15 ;function result
NEW DGRSLT
+16 ;contains flag array
NEW DGFARRY
+17 KILL DGFARRY
+18 ;var returned from BLD^DIALOG
NEW DIERR
+19 ;
+20 ;init error output array if passed
+21 SET DGEROOT=$GET(DGEROOT)
+22 IF DGEROOT]""
KILL @DGEROOT
+23 ;
+24 SET DGRSLT=0
+25 ;
+26 ;drops out of block on failure
Begin DoDot:1
+27 ;
+28 ;quit if DFN invalid
+29 IF '$GET(DGDFN)!'$DATA(^DPT(+$GET(DGDFN),0))
Begin DoDot:2
+30 DO BLD^DIALOG(261110,,,DGEROOT,"F")
End DoDot:2
QUIT
+31 ;
+32 ;quit if flag ien invalid
+33 IF '$$TESTVAL^DGPFUT(26.13,.02,DGFLG)
Begin DoDot:2
+34 DO BLD^DIALOG(261111,,,DGEROOT,"F")
End DoDot:2
QUIT
+35 ;
+36 ;quit if flag already assigned to patient
+37 IF $$FNDASGN^DGPFAA(DGDFN,DGFLG)
Begin DoDot:2
+38 DO BLD^DIALOG(261112,,,DGEROOT,"F")
End DoDot:2
QUIT
+39 ;
+40 ;quit if flag STATUS is INACTIVE
+41 IF $$GETFLAG^DGPFUT1(DGFLG,.DGFARRY)
IF ('+$GET(DGFARRY("STAT")))
Begin DoDot:2
+42 DO BLD^DIALOG(261113,,,DGEROOT,"F")
End DoDot:2
QUIT
+43 ;
+44 ;quit if no TIU PN TITLE IEN is found for the record flag
+45 IF '+$PIECE($GET(DGFARRY("TIUTITLE")),U)
Begin DoDot:2
+46 DO BLD^DIALOG(261114,,,DGEROOT,"F")
End DoDot:2
QUIT
+47 ;
+48 ;success
+49 SET DGRSLT=1
End DoDot:1
+50 ;
+51 QUIT DGRSLT
+52 ;
EDTOK(DGPFA,DGORIG,DGEROOT) ;This function will be used to determine if a flag assignment may be edited.
+1 ;
+2 ; Input:
+3 ; DGPFA - (required) array containing the flag assignment values
+4 ; DGORIG - (optional) originating site [default = +$$SITE^VASITE()]
+5 ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
+6 ; error dialog returned from BLD^DIALOG. If not passed,
+7 ; error dialog is returned in ^TMP("DIERR",$J) global.
+8 ;
+9 ; Output:
+10 ; Function Value - returns 1 on success, 0 on failure
+11 ; DGEROOT() - error output array from BLD^DIALOG
+12 ;
+13 ;function result
NEW DGRSLT
+14 ;contains flag array
NEW DGFARRY
+15 KILL DGFARRY
+16 ;var returned from BLD^DIALOG
NEW DIERR
+17 ;
+18 ;init error output array if passed
+19 SET DGEROOT=$GET(DGEROOT)
+20 IF DGEROOT]""
KILL @DGEROOT
+21 ;
+22 SET DGRSLT=0
+23 ;
+24 ;drops out of block on failure
Begin DoDot:1
+25 ;
+26 ;quit if current site is not the owner site
+27 IF +$GET(DGORIG)'>0
SET DGORIG=+$$SITE^VASITE()
+28 IF +$GET(DGPFA("OWNER"))'=DGORIG
Begin DoDot:2
+29 DO BLD^DIALOG(261115,,,DGEROOT,"F")
End DoDot:2
QUIT
+30 ;
+31 ;quit if flag STATUS is INACTIVE
+32 IF $$GETFLAG^DGPFUT1($PIECE($GET(DGPFA("FLAG")),U),.DGFARRY)
+33 IF '+$GET(DGFARRY("STAT"))
Begin DoDot:2
+34 DO BLD^DIALOG(261113,,,DGEROOT,"F")
End DoDot:2
QUIT
+35 ;
+36 ;quit if no TIU PN TITLE is found for the record flag
+37 IF '+$PIECE($GET(DGFARRY("TIUTITLE")),U)
Begin DoDot:2
+38 DO BLD^DIALOG(261114,,,DGEROOT,"F")
End DoDot:2
QUIT
+39 ;
+40 ;success
+41 SET DGRSLT=1
End DoDot:1
+42 ;
+43 QUIT DGRSLT
+44 ;
ACTIONOK(DGPFA,DGACT,DGEROOT) ;This function will be used to verify that an assignment edit ACTION is appropriate for the current assignment STATUS.
+1 ;
+2 ; Input:
+3 ; DGPFA - (required) assignment array data from current record
+4 ; DGACT - Assignment edit action in internal format
+5 ; [1:NEW ASSIGNMENT,2:CONTINUE,3:INACTIVATE,4:REACTIVATE,5:ENTERED IN ERROR]
+6 ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
+7 ; error dialog returned from BLD^DIALOG. If not passed, error
+8 ; dialog is returned in ^TMP("DIERR",$J) global.
+9 ;
+10 ; Output:
+11 ; Function Value - returns 1 on success, 0 on failure
+12 ; DGEROOT() - error output array from BLD^DIALOG
+13 ;
+14 ;function result
NEW DGRSLT
+15 ;current assignment status
NEW DGSTAT
+16 ;var returned from BLD^DIALOG
NEW DIERR
+17 ;
+18 ;init error output array if passed
+19 SET DGEROOT=$GET(DGEROOT)
+20 IF DGEROOT]""
KILL @DGEROOT
+21 ;
+22 SET DGACT=+$GET(DGACT)
+23 SET DGSTAT=$PIECE($GET(DGPFA("STATUS")),U,1)
+24 SET DGRSLT=0
+25 ;
+26 ;drops out of block on failure
Begin DoDot:1
+27 ;
+28 ;is ACTION valid?
+29 IF '$$TESTVAL^DGPFUT(26.14,.03,DGACT)
IF 'DGSTAT?1N
Begin DoDot:2
+30 DO BLD^DIALOG(261118,,,DGEROOT,"F")
End DoDot:2
QUIT
+31 ;
+32 ;must not CONTINUE inactive assignments
+33 IF DGACT=2
IF DGSTAT=0
Begin DoDot:2
+34 DO BLD^DIALOG(261121,,,DGEROOT,"F")
End DoDot:2
QUIT
+35 ;
+36 ;must not INACTIVATE inactive assignments
+37 IF DGACT=3
IF DGSTAT=0
Begin DoDot:2
+38 DO BLD^DIALOG(261122,,,DGEROOT,"F")
End DoDot:2
QUIT
+39 ;
+40 ;must not ENTERED IN ERROR inactive assignments
+41 IF DGACT=5
IF DGSTAT=0
Begin DoDot:2
+42 DO BLD^DIALOG(261123,,,DGEROOT,"F")
End DoDot:2
QUIT
+43 ;
+44 ;must not REACTIVATE active assignments
+45 IF DGACT=4
IF DGSTAT=1
Begin DoDot:2
+46 DO BLD^DIALOG(261124,,,DGEROOT,"F")
End DoDot:2
QUIT
+47 ;
+48 ;success
+49 SET DGRSLT=1
End DoDot:1
+50 ;
+51 QUIT DGRSLT
+52 ;
CHGOWN(DGPFA,DGORIG,DGEROOT) ;This function is used to determine if a site is allowed to change ownership of a record flag assignment?
+1 ;
+2 ; Input:
+3 ; DGPFA - (required) array containing the flag assignment values
+4 ; DGORIG - (optional) originating site [default = +$$SITE^VASITE()]
+5 ; DGEROOT - (optional) closed root array name (i.e. "DGERROR") for
+6 ; error dialog returned from BLD^DIALOG. If not passed,
+7 ; error dialog is returned in ^TMP("DIERR",$J) global.
+8 ;
+9 ; Output:
+10 ; Function Value - returns 1 on success, 0 on failure
+11 ; DGEROOT() - error output array from BLD^DIALOG
+12 ;
+13 ;function result
NEW DGRSLT
+14 ;var returned from BLD^DIALOG
NEW DIERR
+15 ;
+16 ;init error output array if passed
+17 SET DGEROOT=$GET(DGEROOT)
+18 IF DGEROOT]""
KILL @DGEROOT
+19 ;
+20 if (+$GET(DGORIG)'>0)
SET DGORIG=(+$$SITE^VASITE())
+21 SET DGRSLT=0
+22 ;
+23 ;drops out of block on failure
Begin DoDot:1
+24 ;
+25 ;ORIGINATING SITE must be OWNER and flag must be ACTIVE
+26 if ('$$EDTOK(.DGPFA,DGORIG,.DGEROOT))
QUIT
+27 ;
+28 ;can't CHANGE OWNERSHIP for an INACTIVE assignment
+29 IF '+$GET(DGPFA("STATUS"))
Begin DoDot:2
+30 DO BLD^DIALOG(261117,,,DGEROOT,"F")
End DoDot:2
QUIT
+31 ;
+32 ;success
+33 SET DGRSLT=1
End DoDot:1
+34 ;
+35 QUIT DGRSLT
+36 ;
ROLLBACK(DGAIEN,DGPFOA) ;Roll back an assignment record
+1 ;
+2 ; Input:
+3 ; DGAIEN - IEN of assignment to roll back in the PRF ASSIGNMENT
+4 ; (#26.13) file
+5 ; DGPFOA - Assignment data array prior to record modification
+6 ;
+7 ; Output:
+8 ; Function value - 1 on successful rollback, 0 on failure
+9 ;
+10 ;function result
NEW DGRSLT
+11 ;
+12 SET DGRSLT=0
+13 IF +$GET(DGAIEN)
IF $DATA(^DGPF(26.13,DGAIEN))
IF $DATA(DGPFOA)
Begin DoDot:1
+14 NEW DGIENS
+15 SET DGIENS=DGAIEN_","
+16 IF $GET(DGPFOA("DFN"))="@"
Begin DoDot:2
+17 NEW DGEROOT,DGFDA
+18 SET DGFDA(26.13,DGIENS,.01)="@"
+19 DO FILE^DIE("","DGFDA","DGEROOT")
+20 IF '$DATA(DGEROOT)
SET DGRSLT=1
+21 QUIT
End DoDot:2
+22 IF '$TEST
Begin DoDot:2
+23 ; DG*5.3*951 - DBRS# multiple, remove all DBRS# before rollback
+24 DO DEL^DGPFUT6(DGAIEN,26.13)
+25 IF $$STOASGN^DGPFAA(.DGPFOA,.DGEROOT,1)
IF '$DATA(DGEROOT)
SET DGRSLT=1
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 QUIT DGRSLT
