- 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 Feb 19, 2025@00:13:19 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