DGPFAA ;ALB/RPM - PRF ASSIGNMENT API'S ; 3/27/03
;;5.3;Registration;**425,1015**;Aug 13, 1993;Build 21
;
Q ;no direct entry
;
GETALL(DGDFN,DGIENS,DGSTAT,DGCAT) ;retrieve list of assignment IENs
;This function returns an array of patient record flag assignment IENs
;for a given patient. The returned IEN array may optionally be
;filtered by Active or Inactive status and by flag category.
;
; Input:
; DGDFN - (required) Pointer to patient in PATIENT (#2) file
; DGIENS - (required) Result array passed by reference
; DGSTAT - (optional) Status filter (0:Inactive,1:Active,"":Both).
; Defaults to Both.
; DGCAT - (optional) Category filter
; (1:Category I,2:Category II,"":Both). Defaults to Both.
;
; Output:
; Function Value - Count of returned IENs
; DGIENS - Output array subscripted by the assignment IENs
;
N DGCNT ;number of returned values
N DGIEN ;single IEN
N DGCKS ;check status flag (1:check, 0:ignore)
N DGFLAG ;pointer to #26.11 or #26.15
;
S DGCNT=0
I $G(DGDFN)>0,$D(^DGPF(26.13,"B",DGDFN)) D
. S DGFLAG=""
. S DGCKS=0
. S DGSTAT=$G(DGSTAT)
. I DGSTAT=0!(DGSTAT=1) S DGCKS=1
. S DGCAT=+$G(DGCAT)
. S DGCAT=$S(DGCAT=1:"26.15",DGCAT=2:"26.11",1:0)
. F S DGFLAG=$O(^DGPF(26.13,"C",DGDFN,DGFLAG)) Q:(DGFLAG="") D
. . I DGCAT,DGFLAG'[DGCAT Q
. . S DGIEN=$O(^DGPF(26.13,"C",DGDFN,DGFLAG,0))
. . I DGCKS,'$D(^DGPF(26.13,"D",DGDFN,DGSTAT,DGIEN)) Q
. . S DGCNT=DGCNT+1
. . S DGIENS(DGIEN)=""
Q DGCNT
;
GETASGN(DGPFIEN,DGPFA) ;retrieve a single assignment record
;This function returns a single patient record flag assignment in an
;array format.
;
; Input:
; DGPFIEN - (required) Pointer to patient record flag assignment in
; PRF ASSIGNMENT (#26.13) file
; DGPFA - (required) Result array passed by reference
;
; Output:
; Function Value - Returns 1 on success, 0 on failure
; DGPFA - Output array containing assignment record field
; values.
; Subscript Field# Data
; -------------- ------- ---------------------
; "DFN" .01 internal^external
; "FLAG" .02 internal^external
; "STATUS" .03 internal^external
; "OWNER" .04 internal^external
; "ORIGSITE" .05 internal^external
; "REVIEWDT" .06 internal^external
; "NARR",line#,0 1 character string
;
N DGIENS ;IEN string for DIQ
N DGFLDS ;results array for DIQ
N DGERR ;error arrary for DIQ
N DGRSLT
;
S DGRSLT=0
I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D
. S DGIENS=DGPFIEN_","
. D GETS^DIQ(26.13,DGIENS,"*","IEZ","DGFLDS","DGERR")
. Q:$D(DGERR)
. S DGRSLT=1
. S DGPFA("DFN")=$G(DGFLDS(26.13,DGIENS,.01,"I"))_U_$G(DGFLDS(26.13,DGIENS,.01,"E"))
. S DGPFA("FLAG")=$G(DGFLDS(26.13,DGIENS,.02,"I"))_U_$G(DGFLDS(26.13,DGIENS,.02,"E"))
. S DGPFA("STATUS")=$G(DGFLDS(26.13,DGIENS,.03,"I"))_U_$G(DGFLDS(26.13,DGIENS,.03,"E"))
. S DGPFA("OWNER")=$G(DGFLDS(26.13,DGIENS,.04,"I"))_U_$G(DGFLDS(26.13,DGIENS,.04,"E"))
. S DGPFA("ORIGSITE")=$G(DGFLDS(26.13,DGIENS,.05,"I"))_U_$G(DGFLDS(26.13,DGIENS,.05,"E"))
. S DGPFA("REVIEWDT")=$G(DGFLDS(26.13,DGIENS,.06,"I"))_U_$G(DGFLDS(26.13,DGIENS,.06,"E"))
. ;build assignment narrative word processing array
. M DGPFA("NARR")=DGFLDS(26.13,DGIENS,1)
. K DGPFA("NARR","E"),DGPFA("NARR","I")
Q DGRSLT
;
FNDASGN(DGPFDFN,DGPFFLG) ;Find Assignment
; This function finds a patient record flag assignment record.
;
; Input:
; DGDFN - Pointer to patient in the PATIENT (#2) file
; DGFLAG - Pointer to flag in either the PRF LOCAL FLAG (#26.11)
; file or the PRF NATIONAL FLAG (#26.15) file
;
; Output:
; Function Value - Returns IEN of existing record on success, 0 on
; failure
;
N DGIEN
;
I $G(DGPFDFN)>0,($G(DGPFFLG)>0) D
. S DGIEN=$O(^DGPF(26.13,"C",DGPFDFN,DGPFFLG,0))
Q $S($G(DGIEN)>0:DGIEN,1:0)
;
STOASGN(DGPFA,DGPFERR) ;store a single PRF ASSIGNMENT (#26.13) file record
;
; Input:
; DGPFA - (required) array of values to be filed (see GETASGN tag
; above for valid array structure)
; DGPFERR - (optional) passed by reference to contain error messages
;
; Output:
; Function Value - Returns IEN of record on success, 0 on failure
; DGPFERR - Undefined on success, error message on failure
;
N DGSUB
N DGFLD
N DGIEN
N DGIENS
N DGFDA
N DGFDAIEN
N DGERR
F DGSUB="DFN","FLAG","STATUS","OWNER","ORIGSITE" D
. S DGFLD(DGSUB)=$P($G(DGPFA(DGSUB)),U,1)
;
;only build DGFLD("REVIEWDT") if "REVIEWDT" is passed
I $D(DGPFA("REVIEWDT"))=1 S DGFLD("REVIEWDT")=$P(DGPFA("REVIEWDT"),U,1)
;
I $D(DGPFA("NARR")) M DGFLD("NARR")=DGPFA("NARR")
I $$VALID^DGPFUT("DGPFAA1",26.13,.DGFLD,.DGPFERR) D
. S DGIEN=$$FNDASGN^DGPFAA(DGFLD("DFN"),DGFLD("FLAG"))
. I DGIEN S DGIENS=DGIEN_","
. E S DGIENS="+1,"
. S DGFDA(26.13,DGIENS,.01)=DGFLD("DFN")
. S DGFDA(26.13,DGIENS,.02)=DGFLD("FLAG")
. S DGFDA(26.13,DGIENS,.03)=DGFLD("STATUS")
. S DGFDA(26.13,DGIENS,.04)=DGFLD("OWNER")
. S DGFDA(26.13,DGIENS,.05)=DGFLD("ORIGSITE")
. ;
. ;only touch REVIEW DATE (#.06) field if "REVIEWDT" is passed
. I $D(DGFLD("REVIEWDT")) S DGFDA(26.13,DGIENS,.06)=DGFLD("REVIEWDT")
. ;
. S DGFDA(26.13,DGIENS,1)="DGFLD(""NARR"")"
. I DGIEN D
. . D FILE^DIE("","DGFDA","DGERR")
. . I $D(DGERR) S DGIEN=0
. E D
. . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR")
. . I '$D(DGERR) S DGIEN=$G(DGFDAIEN(1))
Q $S($G(DGIEN)>0:DGIEN,1:0)
;
STOALL(DGPFA,DGPFAH,DGPFERR) ;store both the assignment and history record
;This function acts as a wrapper around the $$STOASGN and $$STOHIST
;filer calls.
;
; 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)
; DGPFERR - (optional) passed by reference to contain error messages
;
; Output:
; Function Value - Returns circumflex("^") delimited results of
; $$STOASGN^DGPFAA and $$STOHIST^DGPFAAH calls
; DGPFERR - Undefined on success, error message on failure
;
N DGOIEN ;existing assignment file IEN used for "roll-back"
N DGPFOA ;existing assignment data array used for "roll-back"
N DGAIEN ;assignment file IEN
N DGAHIEN ;assignment history file IEN
N DGDFN ;"DFN" value
N DGFLG ;"FLAG" value
;
S (DGAIEN,DGAHIEN)=0
S DGDFN=$P($G(DGPFA("DFN")),U,1)
S DGFLG=$P($G(DGPFA("FLAG")),U,1)
S DGOIEN=$$FNDASGN^DGPFAA(DGDFN,DGFLG)
D ;drops out of block if can't rollback or assignment filer fails
. I DGOIEN,'$$GETASGN^DGPFAA(DGOIEN,.DGPFOA) Q ;can't rollback, so quit
. ;
. ;store the assignment
. S DGAIEN=$$STOASGN^DGPFAA(.DGPFA,.DGPFERR)
. I $D(DGPFERR) S DGAIEN=0
. Q:'DGAIEN ;assignment filer failed, so quit
. ;
. ;store the assignment history
. S DGPFAH("ASSIGN")=DGAIEN
. S DGAHIEN=$$STOHIST^DGPFAAH(.DGPFAH,.DGPFERR)
. I $D(DGPFERR) S DGAHIEN=0
. I DGAHIEN=0 D ;history filer failed, so rollback the assignment
. . I 'DGOIEN,'$D(DGPFOA) S DGPFOA("DFN")="@"
. . I $$ROLLBACK^DGPFAA2(DGAIEN,.DGPFOA) S DGAIEN=0
Q $S(+$G(DGAHIEN)=0:0,1:DGAIEN_"^"_DGAHIEN)
DGPFAA ;ALB/RPM - PRF ASSIGNMENT API'S ; 3/27/03
+1 ;;5.3;Registration;**425,1015**;Aug 13, 1993;Build 21
+2 ;
+3 ;no direct entry
QUIT
+4 ;
GETALL(DGDFN,DGIENS,DGSTAT,DGCAT) ;retrieve list of assignment IENs
+1 ;This function returns an array of patient record flag assignment IENs
+2 ;for a given patient. The returned IEN array may optionally be
+3 ;filtered by Active or Inactive status and by flag category.
+4 ;
+5 ; Input:
+6 ; DGDFN - (required) Pointer to patient in PATIENT (#2) file
+7 ; DGIENS - (required) Result array passed by reference
+8 ; DGSTAT - (optional) Status filter (0:Inactive,1:Active,"":Both).
+9 ; Defaults to Both.
+10 ; DGCAT - (optional) Category filter
+11 ; (1:Category I,2:Category II,"":Both). Defaults to Both.
+12 ;
+13 ; Output:
+14 ; Function Value - Count of returned IENs
+15 ; DGIENS - Output array subscripted by the assignment IENs
+16 ;
+17 ;number of returned values
NEW DGCNT
+18 ;single IEN
NEW DGIEN
+19 ;check status flag (1:check, 0:ignore)
NEW DGCKS
+20 ;pointer to #26.11 or #26.15
NEW DGFLAG
+21 ;
+22 SET DGCNT=0
+23 IF $GET(DGDFN)>0
IF $DATA(^DGPF(26.13,"B",DGDFN))
Begin DoDot:1
+24 SET DGFLAG=""
+25 SET DGCKS=0
+26 SET DGSTAT=$GET(DGSTAT)
+27 IF DGSTAT=0!(DGSTAT=1)
SET DGCKS=1
+28 SET DGCAT=+$GET(DGCAT)
+29 SET DGCAT=$SELECT(DGCAT=1:"26.15",DGCAT=2:"26.11",1:0)
+30 FOR
SET DGFLAG=$ORDER(^DGPF(26.13,"C",DGDFN,DGFLAG))
IF (DGFLAG="")
QUIT
Begin DoDot:2
+31 IF DGCAT
IF DGFLAG'[DGCAT
QUIT
+32 SET DGIEN=$ORDER(^DGPF(26.13,"C",DGDFN,DGFLAG,0))
+33 IF DGCKS
IF '$DATA(^DGPF(26.13,"D",DGDFN,DGSTAT,DGIEN))
QUIT
+34 SET DGCNT=DGCNT+1
+35 SET DGIENS(DGIEN)=""
End DoDot:2
End DoDot:1
+36 QUIT DGCNT
+37 ;
GETASGN(DGPFIEN,DGPFA) ;retrieve a single assignment record
+1 ;This function returns a single patient record flag assignment in an
+2 ;array format.
+3 ;
+4 ; Input:
+5 ; DGPFIEN - (required) Pointer to patient record flag assignment in
+6 ; PRF ASSIGNMENT (#26.13) file
+7 ; DGPFA - (required) Result array passed by reference
+8 ;
+9 ; Output:
+10 ; Function Value - Returns 1 on success, 0 on failure
+11 ; DGPFA - Output array containing assignment record field
+12 ; values.
+13 ; Subscript Field# Data
+14 ; -------------- ------- ---------------------
+15 ; "DFN" .01 internal^external
+16 ; "FLAG" .02 internal^external
+17 ; "STATUS" .03 internal^external
+18 ; "OWNER" .04 internal^external
+19 ; "ORIGSITE" .05 internal^external
+20 ; "REVIEWDT" .06 internal^external
+21 ; "NARR",line#,0 1 character string
+22 ;
+23 ;IEN string for DIQ
NEW DGIENS
+24 ;results array for DIQ
NEW DGFLDS
+25 ;error arrary for DIQ
NEW DGERR
+26 NEW DGRSLT
+27 ;
+28 SET DGRSLT=0
+29 IF $GET(DGPFIEN)>0
IF $DATA(^DGPF(26.13,DGPFIEN))
Begin DoDot:1
+30 SET DGIENS=DGPFIEN_","
+31 DO GETS^DIQ(26.13,DGIENS,"*","IEZ","DGFLDS","DGERR")
+32 IF $DATA(DGERR)
QUIT
+33 SET DGRSLT=1
+34 SET DGPFA("DFN")=$GET(DGFLDS(26.13,DGIENS,.01,"I"))_U_$GET(DGFLDS(26.13,DGIENS,.01,"E"))
+35 SET DGPFA("FLAG")=$GET(DGFLDS(26.13,DGIENS,.02,"I"))_U_$GET(DGFLDS(26.13,DGIENS,.02,"E"))
+36 SET DGPFA("STATUS")=$GET(DGFLDS(26.13,DGIENS,.03,"I"))_U_$GET(DGFLDS(26.13,DGIENS,.03,"E"))
+37 SET DGPFA("OWNER")=$GET(DGFLDS(26.13,DGIENS,.04,"I"))_U_$GET(DGFLDS(26.13,DGIENS,.04,"E"))
+38 SET DGPFA("ORIGSITE")=$GET(DGFLDS(26.13,DGIENS,.05,"I"))_U_$GET(DGFLDS(26.13,DGIENS,.05,"E"))
+39 SET DGPFA("REVIEWDT")=$GET(DGFLDS(26.13,DGIENS,.06,"I"))_U_$GET(DGFLDS(26.13,DGIENS,.06,"E"))
+40 ;build assignment narrative word processing array
+41 MERGE DGPFA("NARR")=DGFLDS(26.13,DGIENS,1)
+42 KILL DGPFA("NARR","E"),DGPFA("NARR","I")
End DoDot:1
+43 QUIT DGRSLT
+44 ;
FNDASGN(DGPFDFN,DGPFFLG) ;Find Assignment
+1 ; This function finds a patient record flag assignment record.
+2 ;
+3 ; Input:
+4 ; DGDFN - Pointer to patient in the PATIENT (#2) file
+5 ; DGFLAG - Pointer to flag in either the PRF LOCAL FLAG (#26.11)
+6 ; file or the PRF NATIONAL FLAG (#26.15) file
+7 ;
+8 ; Output:
+9 ; Function Value - Returns IEN of existing record on success, 0 on
+10 ; failure
+11 ;
+12 NEW DGIEN
+13 ;
+14 IF $GET(DGPFDFN)>0
IF ($GET(DGPFFLG)>0)
Begin DoDot:1
+15 SET DGIEN=$ORDER(^DGPF(26.13,"C",DGPFDFN,DGPFFLG,0))
End DoDot:1
+16 QUIT $SELECT($GET(DGIEN)>0:DGIEN,1:0)
+17 ;
STOASGN(DGPFA,DGPFERR) ;store a single PRF ASSIGNMENT (#26.13) file record
+1 ;
+2 ; Input:
+3 ; DGPFA - (required) array of values to be filed (see GETASGN tag
+4 ; above for valid array structure)
+5 ; DGPFERR - (optional) passed by reference to contain error messages
+6 ;
+7 ; Output:
+8 ; Function Value - Returns IEN of record on success, 0 on failure
+9 ; DGPFERR - Undefined on success, error message on failure
+10 ;
+11 NEW DGSUB
+12 NEW DGFLD
+13 NEW DGIEN
+14 NEW DGIENS
+15 NEW DGFDA
+16 NEW DGFDAIEN
+17 NEW DGERR
+18 FOR DGSUB="DFN","FLAG","STATUS","OWNER","ORIGSITE"
Begin DoDot:1
+19 SET DGFLD(DGSUB)=$PIECE($GET(DGPFA(DGSUB)),U,1)
End DoDot:1
+20 ;
+21 ;only build DGFLD("REVIEWDT") if "REVIEWDT" is passed
+22 IF $DATA(DGPFA("REVIEWDT"))=1
SET DGFLD("REVIEWDT")=$PIECE(DGPFA("REVIEWDT"),U,1)
+23 ;
+24 IF $DATA(DGPFA("NARR"))
MERGE DGFLD("NARR")=DGPFA("NARR")
+25 IF $$VALID^DGPFUT("DGPFAA1",26.13,.DGFLD,.DGPFERR)
Begin DoDot:1
+26 SET DGIEN=$$FNDASGN^DGPFAA(DGFLD("DFN"),DGFLD("FLAG"))
+27 IF DGIEN
SET DGIENS=DGIEN_","
+28 IF '$TEST
SET DGIENS="+1,"
+29 SET DGFDA(26.13,DGIENS,.01)=DGFLD("DFN")
+30 SET DGFDA(26.13,DGIENS,.02)=DGFLD("FLAG")
+31 SET DGFDA(26.13,DGIENS,.03)=DGFLD("STATUS")
+32 SET DGFDA(26.13,DGIENS,.04)=DGFLD("OWNER")
+33 SET DGFDA(26.13,DGIENS,.05)=DGFLD("ORIGSITE")
+34 ;
+35 ;only touch REVIEW DATE (#.06) field if "REVIEWDT" is passed
+36 IF $DATA(DGFLD("REVIEWDT"))
SET DGFDA(26.13,DGIENS,.06)=DGFLD("REVIEWDT")
+37 ;
+38 SET DGFDA(26.13,DGIENS,1)="DGFLD(""NARR"")"
+39 IF DGIEN
Begin DoDot:2
+40 DO FILE^DIE("","DGFDA","DGERR")
+41 IF $DATA(DGERR)
SET DGIEN=0
End DoDot:2
+42 IF '$TEST
Begin DoDot:2
+43 DO UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR")
+44 IF '$DATA(DGERR)
SET DGIEN=$GET(DGFDAIEN(1))
End DoDot:2
End DoDot:1
+45 QUIT $SELECT($GET(DGIEN)>0:DGIEN,1:0)
+46 ;
STOALL(DGPFA,DGPFAH,DGPFERR) ;store both the assignment and history record
+1 ;This function acts as a wrapper around the $$STOASGN and $$STOHIST
+2 ;filer calls.
+3 ;
+4 ; Input:
+5 ; DGPFA - (required) array of assignment values to be filed (see
+6 ; $$GETASGN^DGPFAA for valid array structure)
+7 ; DGPFAH - (required) array of assignment history values to be filed
+8 ; (see $$STOHIST^DGPFAAH for valid array structure)
+9 ; DGPFERR - (optional) passed by reference to contain error messages
+10 ;
+11 ; Output:
+12 ; Function Value - Returns circumflex("^") delimited results of
+13 ; $$STOASGN^DGPFAA and $$STOHIST^DGPFAAH calls
+14 ; DGPFERR - Undefined on success, error message on failure
+15 ;
+16 ;existing assignment file IEN used for "roll-back"
NEW DGOIEN
+17 ;existing assignment data array used for "roll-back"
NEW DGPFOA
+18 ;assignment file IEN
NEW DGAIEN
+19 ;assignment history file IEN
NEW DGAHIEN
+20 ;"DFN" value
NEW DGDFN
+21 ;"FLAG" value
NEW DGFLG
+22 ;
+23 SET (DGAIEN,DGAHIEN)=0
+24 SET DGDFN=$PIECE($GET(DGPFA("DFN")),U,1)
+25 SET DGFLG=$PIECE($GET(DGPFA("FLAG")),U,1)
+26 SET DGOIEN=$$FNDASGN^DGPFAA(DGDFN,DGFLG)
+27 ;drops out of block if can't rollback or assignment filer fails
Begin DoDot:1
+28 ;can't rollback, so quit
IF DGOIEN
IF '$$GETASGN^DGPFAA(DGOIEN,.DGPFOA)
QUIT
+29 ;
+30 ;store the assignment
+31 SET DGAIEN=$$STOASGN^DGPFAA(.DGPFA,.DGPFERR)
+32 IF $DATA(DGPFERR)
SET DGAIEN=0
+33 ;assignment filer failed, so quit
IF 'DGAIEN
QUIT
+34 ;
+35 ;store the assignment history
+36 SET DGPFAH("ASSIGN")=DGAIEN
+37 SET DGAHIEN=$$STOHIST^DGPFAAH(.DGPFAH,.DGPFERR)
+38 IF $DATA(DGPFERR)
SET DGAHIEN=0
+39 ;history filer failed, so rollback the assignment
IF DGAHIEN=0
Begin DoDot:2
+40 IF 'DGOIEN
IF '$DATA(DGPFOA)
SET DGPFOA("DFN")="@"
+41 IF $$ROLLBACK^DGPFAA2(DGAIEN,.DGPFOA)
SET DGAIEN=0
End DoDot:2
End DoDot:1
+42 QUIT $SELECT(+$GET(DGAHIEN)=0:0,1:DGAIEN_"^"_DGAHIEN)
