PXRMPRF ;SLC/PKR - Computed findings for PRF. ;12/03/2020
;;2.0;CLINICAL REMINDERS;**17,18,47,42**;Feb 4, 2005;Build 245
;Calls to DGPFAPIU supported by DBIA #4903 and 5491.
;==========================================
GETINF(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;VA-PATIENT RECORD FLAG
;INFORMATION computed finding. Return information about a specific
;record flag.
N BDTNT,EDTNTFLAG,FLAGCAT,FLAGNAME,IND,LIST,RESULT,TEMP
I (TEST="")!(NGET=0) S NFOUND=0 Q
S FLAGNAME=$P(TEST,U,1)
S FLAGCAT=$P(TEST,U,2)
I FLAGCAT="" S FLAGCAT="L"
S BDTNT=$P(BDT,".",1)
S EDTNT=$P(EDT,".",1)
;DBIA #5491
S FLAG=$$GETFLAG^DGPFAPIU(FLAGNAME,FLAGCAT)
;DBIA #4903
S RESULT=$$GETINF^DGPFAPIH(DFN,FLAG,BDTNT,EDTNT,"LIST")
S NFOUND=0
I RESULT=0 Q
S IND=0
F IND=+$O(LIST("HIST",IND)) Q:IND=0 D
. S NFOUND=NFOUND+1
. S TEST(NFOUND)=1
. S DATE(NFOUND)=$P(LIST("HIST",IND,"DATETIME"),U,1)
. S (DATA(NFOUND,"VALUE"),DATA(NFOUND,"ACTION"))=$P(LIST("HIST",IND,"ACTION"),U,2)
. S DATA(NFOUND,"APPRVBY")=$P(LIST("HIST",IND,"APPRVBY"),U,2)
. S DATA(NFOUND,"ASSIGN DT")=$P(LIST("ASSIGNDT"),U,1)
. S DATA(NFOUND,"CATEGORY")=$P(LIST("CATEGORY"),U,2)
. S DATA(NFOUND,"FLAGTYPE")=$P(LIST("FLAGTYPE"),U,2)
. S DATA(NFOUND,"REVIEW DT")=$P(LIST("REVIEWDT"),U,1)
. S DATA(NFOUND,"TIU TITLE")=$P(LIST("TIUTITLE"),U,2)
. S TEMP="\\Flag - "_$P(LIST("FLAG"),U,2)_"("_DATA(NFOUND,"CATEGORY")_")."
. S TEMP=TEMP_"\\Assigned "_$P(LIST("ASSIGNDT"),U,2)_" by "_DATA(NFOUND,"APPRVBY")_". "
. S TEMP=TEMP_$G(LIST("HIST",IND,"COMMENT",1,0))
. S TEXT(NFOUND)=TEMP
Q
;
;==========================================
GETLST(NGET,BDT,EDT,PLIST,PARAM) ;VA-PATIENT RECORD FLAG LIST computed finding.
;Return a list of patients with a specified record flag.
N BDTNT,DATE,DFN,EDTNT,FLAGCAT,FLAGNAME,IND,LIST,RESULT
K ^TMP($J,PLIST)
I PARAM="" Q
S FLAGNAME=$P(PARAM,U,1)
S FLAGCAT=$P(PARAM,U,2)
I FLAGCAT="" S FLAGCAT="L"
S BDTNT=$P(BDT,".",1)
S EDTNT=$P(EDT,".",1)
;DBIA #5491
S FLAG=$$GETFLAG^DGPFAPIU(FLAGNAME,FLAGCAT)
;DBIA #4903
S RESULT=$$GETLST^DGPFAPIH(FLAG,BDTNT,EDTNT,"LIST")
I RESULT=0 Q
S DFN=0
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
Q
;
;==========================================
PRF(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
;getting a list of the patient's active flags.
N ASSIGNDT,CAT,DONE,FLAG,FLAGKEEP,FLAGLIST,IND
N NFLAGS,NOCC,OK,SDIR,SUB,TEMP,TYPE
I (TEST="")!(NGET=0) S NFOUND=0 Q
;DBIA #3860
S NFLAGS=$$GETACT^DGPFAPI(DFN,"FLAGLIST")
;If no flags are found quit
I NFLAGS=0 S NFOUND=0 Q
S SDIR=$S(NGET<0:1,1:-1)
S NOCC=$S(NGET<0:-NGET,1:NGET)
;Search the parameter list for category, type, and flag.
S CAT=$F(TEST,"C:")
I CAT>0 S CAT=$E(TEST,CAT),CAT=$S(CAT="N":"NATIONAL",CAT="L":"LOCAL")
S TYPE=$F(TEST,"T:")
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")
S FLAG=$F(TEST,"F:")
I FLAG>0 S TEMP=$E(TEST,FLAG,245),FLAG=$P(TEMP,U,1)
;Check all the flags that were returned and keep those that meet
;the criteria. Order by assigned date.
F IND=1:1:NFLAGS D
. S OK=1
. I CAT'=0,FLAGLIST(IND,"CATEGORY")'[CAT S OK=0
. I TYPE'=0,TYPE'=$P(FLAGLIST(IND,"FLAGTYPE"),U,2) S OK=0
. I FLAG'=0,FLAG'=$P(FLAGLIST(IND,"FLAG"),U,2) S OK=0
. I OK S FLAGKEEP($P(FLAGLIST(IND,"ASSIGNDT"),U,1),IND)=""
S ASSIGNDT="",(DONE,NFOUND)=0
F S ASSIGNDT=$O(FLAGKEEP(ASSIGNDT),SDIR) Q:(DONE)!(ASSIGNDT="") D
. S IND=0
. F S IND=$O(FLAGKEEP(ASSIGNDT,IND)) Q:(DONE)!(IND="") D
.. S NFOUND=NFOUND+1
.. I NFOUND=NOCC S DONE=1
.. S TEST(NFOUND)=1
.. S DATE(NFOUND)=ASSIGNDT
.. S SUB=""
..;Save the CSUB data.
.. F S SUB=$O(FLAGLIST(IND,SUB)) Q:SUB="" D
... I SUB="NARR" Q
... S DATA(NFOUND,SUB)=$P($G(FLAGLIST(IND,SUB)),U,2)
.. S TEXT(NFOUND)=DATA(NFOUND,"FLAG")_"; Category: "_DATA(NFOUND,"CATEGORY")_"; TYPE: "_DATA(NFOUND,"FLAGTYPE")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMPRF 4038 printed Dec 13, 2024@01:48:36 Page 2
PXRMPRF ;SLC/PKR - Computed findings for PRF. ;12/03/2020
+1 ;;2.0;CLINICAL REMINDERS;**17,18,47,42**;Feb 4, 2005;Build 245
+2 ;Calls to DGPFAPIU supported by DBIA #4903 and 5491.
+3 ;==========================================
GETINF(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;VA-PATIENT RECORD FLAG
+1 ;INFORMATION computed finding. Return information about a specific
+2 ;record flag.
+3 NEW BDTNT,EDTNTFLAG,FLAGCAT,FLAGNAME,IND,LIST,RESULT,TEMP
+4 IF (TEST="")!(NGET=0)
SET NFOUND=0
QUIT
+5 SET FLAGNAME=$PIECE(TEST,U,1)
+6 SET FLAGCAT=$PIECE(TEST,U,2)
+7 IF FLAGCAT=""
SET FLAGCAT="L"
+8 SET BDTNT=$PIECE(BDT,".",1)
+9 SET EDTNT=$PIECE(EDT,".",1)
+10 ;DBIA #5491
+11 SET FLAG=$$GETFLAG^DGPFAPIU(FLAGNAME,FLAGCAT)
+12 ;DBIA #4903
+13 SET RESULT=$$GETINF^DGPFAPIH(DFN,FLAG,BDTNT,EDTNT,"LIST")
+14 SET NFOUND=0
+15 IF RESULT=0
QUIT
+16 SET IND=0
+17 FOR IND=+$ORDER(LIST("HIST",IND))
if IND=0
QUIT
Begin DoDot:1
+18 SET NFOUND=NFOUND+1
+19 SET TEST(NFOUND)=1
+20 SET DATE(NFOUND)=$PIECE(LIST("HIST",IND,"DATETIME"),U,1)
+21 SET (DATA(NFOUND,"VALUE"),DATA(NFOUND,"ACTION"))=$PIECE(LIST("HIST",IND,"ACTION"),U,2)
+22 SET DATA(NFOUND,"APPRVBY")=$PIECE(LIST("HIST",IND,"APPRVBY"),U,2)
+23 SET DATA(NFOUND,"ASSIGN DT")=$PIECE(LIST("ASSIGNDT"),U,1)
+24 SET DATA(NFOUND,"CATEGORY")=$PIECE(LIST("CATEGORY"),U,2)
+25 SET DATA(NFOUND,"FLAGTYPE")=$PIECE(LIST("FLAGTYPE"),U,2)
+26 SET DATA(NFOUND,"REVIEW DT")=$PIECE(LIST("REVIEWDT"),U,1)
+27 SET DATA(NFOUND,"TIU TITLE")=$PIECE(LIST("TIUTITLE"),U,2)
+28 SET TEMP="\\Flag - "_$PIECE(LIST("FLAG"),U,2)_"("_DATA(NFOUND,"CATEGORY")_")."
+29 SET TEMP=TEMP_"\\Assigned "_$PIECE(LIST("ASSIGNDT"),U,2)_" by "_DATA(NFOUND,"APPRVBY")_". "
+30 SET TEMP=TEMP_$GET(LIST("HIST",IND,"COMMENT",1,0))
+31 SET TEXT(NFOUND)=TEMP
End DoDot:1
+32 QUIT
+33 ;
+34 ;==========================================
GETLST(NGET,BDT,EDT,PLIST,PARAM) ;VA-PATIENT RECORD FLAG LIST computed finding.
+1 ;Return a list of patients with a specified record flag.
+2 NEW BDTNT,DATE,DFN,EDTNT,FLAGCAT,FLAGNAME,IND,LIST,RESULT
+3 KILL ^TMP($JOB,PLIST)
+4 IF PARAM=""
QUIT
+5 SET FLAGNAME=$PIECE(PARAM,U,1)
+6 SET FLAGCAT=$PIECE(PARAM,U,2)
+7 IF FLAGCAT=""
SET FLAGCAT="L"
+8 SET BDTNT=$PIECE(BDT,".",1)
+9 SET EDTNT=$PIECE(EDT,".",1)
+10 ;DBIA #5491
+11 SET FLAG=$$GETFLAG^DGPFAPIU(FLAGNAME,FLAGCAT)
+12 ;DBIA #4903
+13 SET RESULT=$$GETLST^DGPFAPIH(FLAG,BDTNT,EDTNT,"LIST")
+14 IF RESULT=0
QUIT
+15 SET DFN=0
+16 FOR
SET DFN=+$ORDER(LIST(DFN))
if DFN=0
QUIT
SET ^TMP($JOB,PLIST,DFN,1)=U_$PIECE(LIST(DFN,0),U,3)_U_U_U
+17 QUIT
+18 ;
+19 ;==========================================
PRF(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding for
+1 ;getting a list of the patient's active flags.
+2 NEW ASSIGNDT,CAT,DONE,FLAG,FLAGKEEP,FLAGLIST,IND
+3 NEW NFLAGS,NOCC,OK,SDIR,SUB,TEMP,TYPE
+4 IF (TEST="")!(NGET=0)
SET NFOUND=0
QUIT
+5 ;DBIA #3860
+6 SET NFLAGS=$$GETACT^DGPFAPI(DFN,"FLAGLIST")
+7 ;If no flags are found quit
+8 IF NFLAGS=0
SET NFOUND=0
QUIT
+9 SET SDIR=$SELECT(NGET<0:1,1:-1)
+10 SET NOCC=$SELECT(NGET<0:-NGET,1:NGET)
+11 ;Search the parameter list for category, type, and flag.
+12 SET CAT=$FIND(TEST,"C:")
+13 IF CAT>0
SET CAT=$EXTRACT(TEST,CAT)
SET CAT=$SELECT(CAT="N":"NATIONAL",CAT="L":"LOCAL")
+14 SET TYPE=$FIND(TEST,"T:")
+15 IF TYPE>0
SET TEMP=$EXTRACT(TEST,TYPE,245)
SET TYPE=$PIECE(TEMP,U,1)
SET TYPE=$SELECT(TYPE="B":"BEHAVIORAL",TYPE="C":"CLINICAL",TYPE="O":"OTHER",TYPE="R":"RESEARCH")
+16 SET FLAG=$FIND(TEST,"F:")
+17 IF FLAG>0
SET TEMP=$EXTRACT(TEST,FLAG,245)
SET FLAG=$PIECE(TEMP,U,1)
+18 ;Check all the flags that were returned and keep those that meet
+19 ;the criteria. Order by assigned date.
+20 FOR IND=1:1:NFLAGS
Begin DoDot:1
+21 SET OK=1
+22 IF CAT'=0
IF FLAGLIST(IND,"CATEGORY")'[CAT
SET OK=0
+23 IF TYPE'=0
IF TYPE'=$PIECE(FLAGLIST(IND,"FLAGTYPE"),U,2)
SET OK=0
+24 IF FLAG'=0
IF FLAG'=$PIECE(FLAGLIST(IND,"FLAG"),U,2)
SET OK=0
+25 IF OK
SET FLAGKEEP($PIECE(FLAGLIST(IND,"ASSIGNDT"),U,1),IND)=""
End DoDot:1
+26 SET ASSIGNDT=""
SET (DONE,NFOUND)=0
+27 FOR
SET ASSIGNDT=$ORDER(FLAGKEEP(ASSIGNDT),SDIR)
if (DONE)!(ASSIGNDT="")
QUIT
Begin DoDot:1
+28 SET IND=0
+29 FOR
SET IND=$ORDER(FLAGKEEP(ASSIGNDT,IND))
if (DONE)!(IND="")
QUIT
Begin DoDot:2
+30 SET NFOUND=NFOUND+1
+31 IF NFOUND=NOCC
SET DONE=1
+32 SET TEST(NFOUND)=1
+33 SET DATE(NFOUND)=ASSIGNDT
+34 SET SUB=""
+35 ;Save the CSUB data.
+36 FOR
SET SUB=$ORDER(FLAGLIST(IND,SUB))
if SUB=""
QUIT
Begin DoDot:3
+37 IF SUB="NARR"
QUIT
+38 SET DATA(NFOUND,SUB)=$PIECE($GET(FLAGLIST(IND,SUB)),U,2)
End DoDot:3
+39 SET TEXT(NFOUND)=DATA(NFOUND,"FLAG")_"; Category: "_DATA(NFOUND,"CATEGORY")_"; TYPE: "_DATA(NFOUND,"FLAGTYPE")
End DoDot:2
End DoDot:1
+40 QUIT
+41 ;
