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

PXRMPRF.m

Go to the documentation of this file.
  1. PXRMPRF ;SLC/PKR - Computed findings for PRF. ;12/03/2020
  1. ;;2.0;CLINICAL REMINDERS;**17,18,47,42**;Feb 4, 2005;Build 245
  1. ;Calls to DGPFAPIU supported by DBIA #4903 and 5491.
  1. ;==========================================
  1. GETINF(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;VA-PATIENT RECORD FLAG
  1. ;INFORMATION computed finding. Return information about a specific
  1. ;record flag.
  1. N BDTNT,EDTNTFLAG,FLAGCAT,FLAGNAME,IND,LIST,RESULT,TEMP
  1. I (TEST="")!(NGET=0) S NFOUND=0 Q
  1. S FLAGNAME=$P(TEST,U,1)
  1. S FLAGCAT=$P(TEST,U,2)
  1. I FLAGCAT="" S FLAGCAT="L"
  1. S BDTNT=$P(BDT,".",1)
  1. S EDTNT=$P(EDT,".",1)
  1. ;DBIA #5491
  1. S FLAG=$$GETFLAG^DGPFAPIU(FLAGNAME,FLAGCAT)
  1. ;DBIA #4903
  1. S RESULT=$$GETINF^DGPFAPIH(DFN,FLAG,BDTNT,EDTNT,"LIST")
  1. S NFOUND=0
  1. I RESULT=0 Q
  1. S IND=0
  1. F IND=+$O(LIST("HIST",IND)) Q:IND=0 D
  1. . S NFOUND=NFOUND+1
  1. . S TEST(NFOUND)=1
  1. . S DATE(NFOUND)=$P(LIST("HIST",IND,"DATETIME"),U,1)
  1. . S (DATA(NFOUND,"VALUE"),DATA(NFOUND,"ACTION"))=$P(LIST("HIST",IND,"ACTION"),U,2)
  1. . S DATA(NFOUND,"APPRVBY")=$P(LIST("HIST",IND,"APPRVBY"),U,2)
  1. . S DATA(NFOUND,"ASSIGN DT")=$P(LIST("ASSIGNDT"),U,1)
  1. . S DATA(NFOUND,"CATEGORY")=$P(LIST("CATEGORY"),U,2)
  1. . S DATA(NFOUND,"FLAGTYPE")=$P(LIST("FLAGTYPE"),U,2)
  1. . S DATA(NFOUND,"REVIEW DT")=$P(LIST("REVIEWDT"),U,1)
  1. . S DATA(NFOUND,"TIU TITLE")=$P(LIST("TIUTITLE"),U,2)
  1. . S TEMP="\\Flag - "_$P(LIST("FLAG"),U,2)_"("_DATA(NFOUND,"CATEGORY")_")."
  1. . S TEMP=TEMP_"\\Assigned "_$P(LIST("ASSIGNDT"),U,2)_" by "_DATA(NFOUND,"APPRVBY")_". "
  1. . S TEMP=TEMP_$G(LIST("HIST",IND,"COMMENT",1,0))
  1. . S TEXT(NFOUND)=TEMP
  1. Q
  1. ;
  1. ;==========================================
  1. GETLST(NGET,BDT,EDT,PLIST,PARAM) ;VA-PATIENT RECORD FLAG LIST computed finding.
  1. ;Return a list of patients with a specified record flag.
  1. N BDTNT,DATE,DFN,EDTNT,FLAGCAT,FLAGNAME,IND,LIST,RESULT
  1. K ^TMP($J,PLIST)
  1. I PARAM="" Q
  1. S FLAGNAME=$P(PARAM,U,1)
  1. S FLAGCAT=$P(PARAM,U,2)
  1. I FLAGCAT="" S FLAGCAT="L"
  1. S BDTNT=$P(BDT,".",1)
  1. S EDTNT=$P(EDT,".",1)
  1. ;DBIA #5491
  1. S FLAG=$$GETFLAG^DGPFAPIU(FLAGNAME,FLAGCAT)
  1. ;DBIA #4903
  1. S RESULT=$$GETLST^DGPFAPIH(FLAG,BDTNT,EDTNT,"LIST")
  1. I RESULT=0 Q
  1. S DFN=0
  1. F S DFN=+$O(LIST(DFN)) Q:DFN=0 S ^TMP($J,PLIST,DFN,1)=U_$P(LIST(DFN,0),U,3)_U_U_U
  1. Q
  1. ;
  1. ;==========================================
  1. PRF(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
  1. ;getting a list of the patient's active flags.
  1. N ASSIGNDT,CAT,DONE,FLAG,FLAGKEEP,FLAGLIST,IND
  1. N NFLAGS,NOCC,OK,SDIR,SUB,TEMP,TYPE
  1. I (TEST="")!(NGET=0) S NFOUND=0 Q
  1. ;DBIA #3860
  1. S NFLAGS=$$GETACT^DGPFAPI(DFN,"FLAGLIST")
  1. ;If no flags are found quit
  1. I NFLAGS=0 S NFOUND=0 Q
  1. S SDIR=$S(NGET<0:1,1:-1)
  1. S NOCC=$S(NGET<0:-NGET,1:NGET)
  1. ;Search the parameter list for category, type, and flag.
  1. S CAT=$F(TEST,"C:")
  1. I CAT>0 S CAT=$E(TEST,CAT),CAT=$S(CAT="N":"NATIONAL",CAT="L":"LOCAL")
  1. S TYPE=$F(TEST,"T:")
  1. I TYPE>0 S TEMP=$E(TEST,TYPE,245),TYPE=$P(TEMP,U,1),TYPE=$S(TYPE="B":"BEHAVIORAL",TYPE="C":"CLINICAL",TYPE="O":"OTHER",TYPE="R":"RESEARCH")
  1. S FLAG=$F(TEST,"F:")
  1. I FLAG>0 S TEMP=$E(TEST,FLAG,245),FLAG=$P(TEMP,U,1)
  1. ;Check all the flags that were returned and keep those that meet
  1. ;the criteria. Order by assigned date.
  1. F IND=1:1:NFLAGS D
  1. . S OK=1
  1. . I CAT'=0,FLAGLIST(IND,"CATEGORY")'[CAT S OK=0
  1. . I TYPE'=0,TYPE'=$P(FLAGLIST(IND,"FLAGTYPE"),U,2) S OK=0
  1. . I FLAG'=0,FLAG'=$P(FLAGLIST(IND,"FLAG"),U,2) S OK=0
  1. . I OK S FLAGKEEP($P(FLAGLIST(IND,"ASSIGNDT"),U,1),IND)=""
  1. S ASSIGNDT="",(DONE,NFOUND)=0
  1. F S ASSIGNDT=$O(FLAGKEEP(ASSIGNDT),SDIR) Q:(DONE)!(ASSIGNDT="") D
  1. . S IND=0
  1. . F S IND=$O(FLAGKEEP(ASSIGNDT,IND)) Q:(DONE)!(IND="") D
  1. .. S NFOUND=NFOUND+1
  1. .. I NFOUND=NOCC S DONE=1
  1. .. S TEST(NFOUND)=1
  1. .. S DATE(NFOUND)=ASSIGNDT
  1. .. S SUB=""
  1. ..;Save the CSUB data.
  1. .. F S SUB=$O(FLAGLIST(IND,SUB)) Q:SUB="" D
  1. ... I SUB="NARR" Q
  1. ... S DATA(NFOUND,SUB)=$P($G(FLAGLIST(IND,SUB)),U,2)
  1. .. S TEXT(NFOUND)=DATA(NFOUND,"FLAG")_"; Category: "_DATA(NFOUND,"CATEGORY")_"; TYPE: "_DATA(NFOUND,"FLAGTYPE")
  1. Q
  1. ;