- 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)