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

DGPFAA.m

Go to the documentation of this file.
  1. DGPFAA ;ALB/RPM,ASMR/JD - PRF ASSIGNMENT API'S ; 11/16/16 6:47pm
  1. ;;5.3;Registration;**425,921,951,1005**;Aug 13, 1993;Build 57
  1. ; Last edited: SHRPE/SGM - Sep 26, 2018 17:06
  1. ;
  1. ; DE2813 - JD - 10/28/15
  1. ;Done for eHMP project: DG*5.3*921
  1. ;Add logic to trigger an unsolicited update when a patient flag is updated.
  1. ;New code: Tag UU and any reference to that tag thereof.
  1. ; SHRPE/sgm - Jan 22, 2018
  1. ;Done for SHRPE project: DG*5.3*951
  1. ; GETASGN is called via ICR. So new input parameter introduced that
  1. ; is not part of the ICR for returning DBRS data.
  1. ;
  1. ; ICR# TYPE DESCRIPTION
  1. ;----- ---- ----------------------------------
  1. ; 872 CSub Global read of B index on file 101
  1. ; 2056 Sup GETS^DIQ
  1. ; 2053 Sup ^DIE: FILE, UPDATE
  1. ;10101 Sup EN1^XQOR
  1. ;
  1. Q ;no direct entry
  1. ;
  1. GETALL(DGDFN,DGIENS,DGSTAT,DGCAT) ;retrieve list of assignment IENs
  1. ;This function returns an array of patient record flag assignment IENs
  1. ;for a given patient. The returned IEN array may optionally be
  1. ;filtered by Active or Inactive status and by flag category.
  1. ;
  1. ; Input:
  1. ; DGDFN - (required) Pointer to patient in PATIENT (#2) file
  1. ; DGIENS - (required) Result array passed by reference
  1. ; DGSTAT - (optional) Status filter (0:Inactive,1:Active,"":Both).
  1. ; Defaults to Both.
  1. ; DGCAT - (optional) Category filter
  1. ; (1:Category I,2:Category II,"":Both). Defaults to Both.
  1. ;
  1. ; Output:
  1. ; Function Value - Count of returned IENs
  1. ; DGIENS - Output array subscripted by the assignment IENs
  1. ;
  1. N DGCNT ;number of returned values
  1. N DGIEN ;single IEN
  1. N DGCKS ;check status flag (1:check, 0:ignore)
  1. N DGFLAG ;pointer to #26.11 or #26.15
  1. ;
  1. S DGCNT=0
  1. I $G(DGDFN)>0,$D(^DGPF(26.13,"B",DGDFN)) D
  1. . S DGFLAG=""
  1. . S DGCKS=0
  1. . S DGSTAT=$G(DGSTAT)
  1. . I DGSTAT=0!(DGSTAT=1) S DGCKS=1
  1. . S DGCAT=+$G(DGCAT)
  1. . S DGCAT=$S(DGCAT=1:"26.15",DGCAT=2:"26.11",1:0)
  1. . F S DGFLAG=$O(^DGPF(26.13,"C",DGDFN,DGFLAG)) Q:(DGFLAG="") D
  1. . . I DGCAT,DGFLAG'[DGCAT Q
  1. . . S DGIEN=$O(^DGPF(26.13,"C",DGDFN,DGFLAG,0))
  1. . . I DGCKS,'$D(^DGPF(26.13,"D",DGDFN,DGSTAT,DGIEN)) Q
  1. . . S DGCNT=DGCNT+1
  1. . . S DGIENS(DGIEN)=""
  1. Q DGCNT
  1. ;
  1. GETASGN(DGPFIEN,DGPFA,DGDBRS) ;retrieve a single assignment record
  1. ;This function returns a single patient record flag assignment in an
  1. ;array format.
  1. ;
  1. ; Input:
  1. ; DGPFIEN - (required) Pointer to patient record flag assignment in
  1. ; PRF ASSIGNMENT (#26.13) file
  1. ; DGPFA - (required) Result array passed by reference
  1. ; DGDBRS - (optional) 1:return DBRS info in DGPFA() ; dg*951
  1. ;
  1. ; Output:
  1. ; Function Value - Returns 1 on success, 0 on failure
  1. ; DGPFA - Output array containing assignment record field
  1. ; values.
  1. ; Subscript Field# Data
  1. ; -------------- ------- ---------------------
  1. ; "DFN" .01 internal^external
  1. ; "FLAG" .02 internal^external
  1. ; "STATUS" .03 internal^external
  1. ; "OWNER" .04 internal^external
  1. ; "ORIGSITE" .05 internal^external
  1. ; "REVIEWDT" .06 internal^external
  1. ; "NARR",line#,0 1 character string
  1. ; If input DGDBRS>0 then
  1. ; "DBRS#",line# 2;.01 internal^external
  1. ; "DBRS OTHER",line# 2;.02 internal^external
  1. ; "DBRS DATE",line# 2;.03 internal^external
  1. ; "DBRS SITE",line# 2;.04 internal^external
  1. ;
  1. N DGRSLT
  1. ;
  1. S DGRSLT=0
  1. I $G(DGPFIEN)>0,$D(^DGPF(26.13,DGPFIEN)) D
  1. . N DGIENS ;IEN string for DIQ
  1. . N DGFLDS ;results array for DIQ
  1. . N DGERR ;error array for DIQ
  1. . N ARR,DF,DIERR
  1. . S DGIENS=DGPFIEN_","
  1. . S DF="*" I +$G(DGDBRS) S DF="**" ; dg*5.3*951
  1. . D GETS^DIQ(26.13,DGIENS,DF,"IEZ","DGFLDS","DGERR")
  1. . Q:$D(DGERR)
  1. . M ARR=DGFLDS(26.13,DGIENS)
  1. . S DGRSLT=1
  1. . S DGPFA("DFN")=$G(ARR(.01,"I"))_U_$G(ARR(.01,"E"))
  1. . S DGPFA("FLAG")=$G(ARR(.02,"I"))_U_$G(ARR(.02,"E"))
  1. . S DGPFA("STATUS")=$G(ARR(.03,"I"))_U_$G(ARR(.03,"E"))
  1. . S DGPFA("OWNER")=$G(ARR(.04,"I"))_U_$G(ARR(.04,"E"))
  1. . S DGPFA("ORIGSITE")=$G(ARR(.05,"I"))_U_$G(ARR(.05,"E"))
  1. . S DGPFA("REVIEWDT")=$G(ARR(.06,"I"))_U_$G(ARR(.06,"E"))
  1. . ;build assignment narrative word processing array
  1. . M DGPFA("NARR")=ARR(1)
  1. . K DGPFA("NARR","E"),DGPFA("NARR","I")
  1. . I $D(DGFLDS(26.131)) D DBRS ; DG*5.3*951
  1. . Q
  1. Q DGRSLT
  1. ;
  1. FNDASGN(DGPFDFN,DGPFFLG) ;Find Assignment
  1. ; This function finds a patient record flag assignment record.
  1. ;
  1. ; Input:
  1. ; DGDFN - Pointer to patient in the PATIENT (#2) file
  1. ; DGFLAG - Pointer to flag in either the PRF LOCAL FLAG (#26.11)
  1. ; file or the PRF NATIONAL FLAG (#26.15) file
  1. ;
  1. ; Output:
  1. ; Function Value - Returns IEN of existing record on success, 0 on
  1. ; failure
  1. ;
  1. N DGIEN
  1. ;
  1. I $G(DGPFDFN)>0,($G(DGPFFLG)>0) D
  1. . S DGIEN=$O(^DGPF(26.13,"C",DGPFDFN,DGPFFLG,0))
  1. Q $S($G(DGIEN)>0:DGIEN,1:0)
  1. ;
  1. STOASGN(DGPFA,DGPFERR,DGPFUV) ;
  1. ;Store a single PRF ASSIGNMENT (#26.13) file record
  1. ;
  1. ; Input:
  1. ; DGPFA - (required) array of values to be filed (see GETASGN tag
  1. ; above for valid array structure)
  1. ; DGPFA() contains 2 "^"-pieces when called from AF/EF
  1. ; 1 "^"-piece when called from HL
  1. ; DGPFA("ACTION")=DGPFAH("ACTION") added by EF action and HL
  1. ; DGPFA("ACTION") = internal [ACTION; 26.14,.03]
  1. ; DGPFERR - (optional) passed by reference to contain error messages
  1. ; DGPFUV - (optional) see STOALL
  1. ; required to file DBRS data
  1. ;
  1. ; Output:
  1. ; Function Value - Returns IEN of record on success, 0 on failure
  1. ; DGPFERR - Undefined on success, error message on failure
  1. ;
  1. N I,X,DGFLD,DGIEN,DGPFERR,DGSUB
  1. S DGPFUV=$$UV
  1. S X="ACTION^DFN^FLAG^ORIGSITE^OWNER^STATUS"
  1. F I=1:1:$L(X,U) S DGSUB=$P(X,U,I),DGFLD(DGSUB)=$P($G(DGPFA(DGSUB)),U)
  1. ;
  1. ;only build DGFLD("REVIEWDT") if "REVIEWDT" is passed
  1. I $D(DGPFA("REVIEWDT"))=1 S DGFLD("REVIEWDT")=$P(DGPFA("REVIEWDT"),U,1)
  1. ;
  1. I $D(DGPFA("NARR")) M DGFLD("NARR")=DGPFA("NARR")
  1. ;
  1. ;REFRESH option may reset STATUS value - DG*5.3*951
  1. S X=DGFLD("ACTION") I (X=7)!(X=8) S DGFLD("STATUS")=X-7
  1. ;
  1. I $$VALID^DGPFUT("DGPFAA1",26.13,.DGFLD,.DGPFERR) D
  1. . N X,DGDBRSE,DGCUR,DGFDA,DGFDAIEN,DGIENS,UPD
  1. . S DGIEN=$$FNDASGN^DGPFAA(DGFLD("DFN"),DGFLD("FLAG"))
  1. . I DGIEN S X=$$GETASGN(DGIEN,.DGCUR,1)
  1. . I DGIEN S DGIENS=DGIEN_","
  1. . E S DGIENS="+1,"
  1. . S DGFDA(26.13,DGIENS,.01)=DGFLD("DFN")
  1. . S DGFDA(26.13,DGIENS,.02)=DGFLD("FLAG")
  1. . S DGFDA(26.13,DGIENS,.03)=DGFLD("STATUS")
  1. . S DGFDA(26.13,DGIENS,.04)=DGFLD("OWNER")
  1. . S DGFDA(26.13,DGIENS,.05)=DGFLD("ORIGSITE")
  1. . ;
  1. . ;only touch REVIEW DATE (#.06) field if "REVIEWDT" is passed
  1. . ;if called from REFRESH option re-evaluate - DG*5.3*951
  1. . S X=DGFLD("ACTION") I (X=7)!(X=8) D
  1. . . I '$$ISDIV^DGPFUT(DGFLD("OWNER")) S DGFLD("REVIEWDT")="" Q
  1. . . I 'DGFLD("STATUS") S DGFLD("REVIEWDT")="" Q
  1. . . I +$G(DGCUR("REVIEWDT")) Q
  1. . . ;calculate the default review date
  1. . . S DGFLD("REVIEWDT")=$$GETRDT^DGPFAA3(DGFLD("FLAG"),$$NOW^XLFDT)
  1. . . Q
  1. . I $D(DGFLD("REVIEWDT")) S DGFDA(26.13,DGIENS,.06)=DGFLD("REVIEWDT")
  1. . ;
  1. . I $D(DGFLD("NARR")) S DGFDA(26.13,DGIENS,1)=$NA(DGFLD("NARR"))
  1. . ;
  1. . ;add in DBRS# data into .DGFDA ; dg*5.3*951
  1. . ; if all existing DBRS data was deleted, $D(DGPFA("DBRS#"))=0
  1. . ; DGPFA("ACTION")=History action code (may not be present)
  1. . ;
  1. . I DGPFUV'=-1,$L($T(AASGN^DGPFUT6)),+$$FLAG(DGFLD("FLAG")) D
  1. . . N ACT S ACT=+DGFLD("ACTION")
  1. . . I ACT=3 S DGPFUV=""
  1. . . I ACT=5 S DGPFUV="d"
  1. . . I ACT=7 S DGPFUV="D"
  1. . . D AASGN^DGPFUT6(DGIENS,.DGPFA,.DGFDA,DGPFUV,.DGPFERR)
  1. . . Q
  1. . Q:$D(DGPFERR)
  1. . ;
  1. . ;determine if update or file should be called
  1. . S UPD=(DGIENS["+") I 'UPD D
  1. . . N I,J
  1. . . S I=0 F J=0:0 S I=$O(DGFDA(26.131,I)) Q:I="" I I["+" S UPD=1 Q
  1. . . Q
  1. . ;
  1. . ; variable needed for ^DD(26.131,.01,"DEL")
  1. . I $G(DGPFA("ACTION"))=5 S DGDBRSE=1
  1. . I 'UPD D
  1. . . N DGERR,DIERR
  1. . . D FILE^DIE("","DGFDA","DGERR")
  1. . . I $D(DGERR) S DGIEN=0
  1. . . ;DG*5.3*921 - Trigger an unsolicited update if a patient flag is updated
  1. . . ;I '$D(DGERR) D UU(.DGPFA)
  1. . . Q
  1. . E D
  1. . . N DGERR,DIERR
  1. . . D UPDATE^DIE("","DGFDA","DGFDAIEN","DGERR")
  1. . . I $D(DGERR),DGIENS'="+1," S DGIEN=0
  1. . . I '$D(DGERR),DGIENS="+1," S DGIEN=$G(DGFDAIEN(1))
  1. . . Q
  1. . Q
  1. Q $S($G(DGIEN)>0:DGIEN,1:0)
  1. ;
  1. STOALL(DGPFA,DGPFAH,DGPFERR,DGPFUV) ;
  1. ;Store both the assignment and history record
  1. ;This function acts as a wrapper around the $$STOASGN and $$STOHIST
  1. ;filer calls.
  1. ;
  1. ; INPUT PARAMETERS:
  1. ; DGPFA - (required) array of assignment values to be filed (see
  1. ; $$GETASGN^DGPFAA for valid array structure)
  1. ; DGPFAH - (required) array of assignment history values to be filed
  1. ; (see $$STOHIST^DGPFAAH for valid array structure)
  1. ; DGPFERR - (optional) passed by reference to contain error messages
  1. ; DGPFUV - (optional) generic flag, single character, intent allow
  1. ; calls to STOALL to flag special handling cases
  1. ; D: STOASGN - first, mark all existing DBRS records for
  1. ; delete in FDA(). DGPFUT62 processing continues
  1. ; d: STOASGN - first, mark all existing DBRS records for
  1. ; delete in FDA(). DGPFUT62 processing stops and exits
  1. ; -1: DGPFUV was not passed in
  1. ; [difference between null and '$D(DGPFUV)]
  1. ;
  1. ; Output:
  1. ; Function Value - Returns circumflex("^") delimited results of
  1. ; $$STOASGN^DGPFAA and $$STOHIST^DGPFAAH calls
  1. ; DGPFERR - Undefined on success, error message on failure
  1. ;
  1. N DGOIEN ;existing assignment file IEN used for "roll-back"
  1. N DGPFOA ;existing assignment data array used for "roll-back"
  1. N DGAIEN ;assignment file IEN
  1. N DGAHIEN ;assignment history file IEN
  1. N DGDFN ;"DFN" value
  1. N DGFLG ;"FLAG" value
  1. ;
  1. S (DGAIEN,DGAHIEN)=0
  1. S DGDFN=$P($G(DGPFA("DFN")),U,1)
  1. S DGFLG=$P($G(DGPFA("FLAG")),U,1)
  1. S DGPFUV=$$UV
  1. S DGOIEN=$$FNDASGN^DGPFAA(DGDFN,DGFLG)
  1. D ;drops out of block if can't rollback or assignment filer fails
  1. . I DGOIEN,'$$GETASGN^DGPFAA(DGOIEN,.DGPFOA,1) Q ;can't rollback, so quit
  1. . ;
  1. . ;store the assignment
  1. . I '$D(DGPFA("ACTION")) S DGPFA("ACTION")=+$G(DGPFAH("ACTION"))
  1. . S DGAIEN=$$STOASGN^DGPFAA(.DGPFA,.DGPFERR,DGPFUV)
  1. . I $D(DGPFERR) S DGAIEN=0
  1. . Q:'DGAIEN ;assignment filer failed, so quit
  1. . ;
  1. . ;store the assignment history
  1. . S DGPFAH("ASSIGN")=DGAIEN
  1. . S DGAHIEN=$$STOHIST^DGPFAAH(.DGPFAH,.DGPFERR)
  1. . I $D(DGPFERR) S DGAHIEN=0
  1. . I DGAHIEN=0 D ;history filer failed, so rollback the assignment
  1. . . I 'DGOIEN,'$D(DGPFOA) S DGPFOA("DFN")="@"
  1. . . I $$ROLLBACK^DGPFAA2(DGAIEN,.DGPFOA) S DGAIEN=0
  1. . . Q
  1. . ;
  1. . ;post protocol event
  1. . I DGAIEN D UU(DGAIEN,.DGPFA)
  1. . Q
  1. Q $S(+$G(DGAHIEN)=0:0,1:DGAIEN_"^"_DGAHIEN)
  1. ;
  1. UU(DGIEN,DGPRF) ;Fire off event protocol
  1. ; DGIEN - (required) Pointer to patient record flag assignment in
  1. ; PRF ASSIGNMENT (#26.13) file
  1. ; DGPRF - (required) array of assignment values to be filed (see
  1. ; $$GETASGN for array structure)
  1. N DGDFN,X
  1. S DGDFN=+$G(DGPRF("DFN"))
  1. S X=+$O(^ORD(101,"B","DGPF PRF EVENT",0))_";ORD(101,"
  1. D:X EN^XQOR
  1. Q
  1. ;
  1. DBRS ; DG*5.3*951
  1. ; add DBRS data to DGPFA()
  1. N I,X,Y,IENS
  1. S (I,IENS)=0
  1. F S IENS=$O(DGFLDS(26.131,IENS)) Q:IENS="" D
  1. . N ARR M ARR=DGFLDS(26.131,IENS)
  1. . S I=I+1
  1. . S X=ARR(.01,"I") S DGPFA("DBRS#",I)=X_U_X
  1. . S (X,Y)=ARR(.02,"I") S:Y="" Y="<no value>"
  1. . S DGPFA("DBRS OTHER",I)=X_U_Y
  1. . S DGPFA("DBRS DATE",I)=ARR(.03,"I")_U_ARR(.03,"E")
  1. . S DGPFA("DBRS SITE",I)=ARR(.04,"I")_U_ARR(.04,"E")
  1. . Q
  1. Q
  1. ;
  1. FLAG(VARPTR) ;
  1. ; Verify that variable flag pointer is BEHAVIORAL, Category I
  1. ; DGPFIN - required - variable pointer to 26.11 / 26.15
  1. Q $$FLAG^DGPFUT6(VARPTR,"BEHAVIORAL","I")
  1. ;
  1. UV() ; return edited value for DGPFUV
  1. ; if '$D(DGPFUV) then set DGPFUV=-1
  1. ; also called from ^DGPFUT62
  1. N Y,RET
  1. S RET=-1
  1. I '$D(DGPFUV) S DGPFUV=-1 ;DG*991
  1. S Y=DGPFUV I $D(DGPFUV)#2 D
  1. . I $L(Y)<2 S RET=$S("dD"[Y:Y,1:"") Q
  1. . I Y["d" S RET="d" Q
  1. . I (Y["AD")!(Y["DA") S RET="D" Q
  1. . S RET=$S(Y["D":"D",1:"")
  1. . Q
  1. Q RET