PXRMARCH ;SLC/PKR/BNT - Clinical Reminder ARCH routines. ;12/09/2011
;;2.0;CLINICAL REMINDERS;**20,23**;Feb 04, 2005;Build 3
;==========================================================
ELIG(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multiple occurrence
;computed finding for ARCH eligibility.
N ARCHDATA,IND,SDIR
;DBIA #5619
S IND=$$ELIG^FBARCH0(DFN,BDT,EDT,.ARCHDATA)
S SDIR=$S(NGET<0:-1,1:1)
S NGET=$S(NGET<0:-NGET,1:NGET)
S IND="",NFOUND=0
F S IND=$O(ARCHDATA(IND),SDIR) Q:(IND="")!(NFOUND=NGET) D
. S NFOUND=NFOUND+1
. S TEST(NFOUND)=$P(ARCHDATA(IND),U,1)
. S DATE(NFOUND)=$P(ARCHDATA(IND),U,2)
. S TEXT(NFOUND)=""
Q
;
;==========================================================
LIST(NGET,BDT,EDT,PLIST,PARAM) ;List computed finding for building a list
;of ARCH eligible patients.
N CNT,DATE,DFN,IND,NL,TEMP
;DBIA #5619
S NL=$$LIST^FBARCH0(BDT,EDT)
F IND=1:1:NL D
. S TEMP=^TMP($J,"ARCHFEE",IND)
.;Check eligibility.
. I '$P(TEMP,U,2) Q
. S DFN=$P(TEMP,U,1),DATE=$P(TEMP,U,3)
. S ^TMP($J,"TLIST",DFN,DATE)=""
S DFN=""
F S DFN=$O(^TMP($J,"TLIST",DFN)) Q:DFN="" D
. S CNT=0,DATE=""
. F S DATE=$O(^TMP($J,"TLIST",DFN,DATE)) Q:(DATE="")!(CNT=NGET) D
.. S CNT=CNT+1,^TMP($J,PLIST,DFN,CNT)=U_DATE
K ^TMP($J,"ARCHFEE"),^TMP($J,"TLIST")
Q
;
;==========================================================
ISDUE(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multiple occurrence
; computed finding for a Project ARCH Reminder Custom Date Due.
; The $$GETDELAY^FBARCH0 API returns a site defined numeric value that represents
; the number of days to delay the reminder from being due again after
; being declined or refused through one of the related health factors.
;
; $$GETDELAY^FBARCH0 Supported by IA 5619
;
N X,HFID,ARCHVHF,ARCHDLAY
S NFOUND=1
S ARCHDLAY=$$GETDELAY^FBARCH0()
S ARCHVHF($P($$NOW^PXRMDATE(),"."))=""
; Get DECLINES and REFUSES Health Factor ID and last date created
F X="DECLINES","REFUSES" S HFID=$O(^AUTTHF("B","ARCH-SERVICE NEEDED THIS VISIT "_X,0)) D
. Q:'$D(^PXRMINDX(9000010.23,"PI",DFN,HFID))
. ; Get date and add delay value
. S ARCHVHF($$FMADD^XLFDT($P($O(^PXRMINDX(9000010.23,"PI",DFN,HFID," "),-1),"."),ARCHDLAY))=""
S TEST(NFOUND)=1
S TEXT(NFOUND)=""
S DATE(NFOUND)=$O(ARCHVHF(" "),-1)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMARCH 2340 printed Dec 13, 2024@01:42:59 Page 2
PXRMARCH ;SLC/PKR/BNT - Clinical Reminder ARCH routines. ;12/09/2011
+1 ;;2.0;CLINICAL REMINDERS;**20,23**;Feb 04, 2005;Build 3
+2 ;==========================================================
ELIG(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multiple occurrence
+1 ;computed finding for ARCH eligibility.
+2 NEW ARCHDATA,IND,SDIR
+3 ;DBIA #5619
+4 SET IND=$$ELIG^FBARCH0(DFN,BDT,EDT,.ARCHDATA)
+5 SET SDIR=$SELECT(NGET<0:-1,1:1)
+6 SET NGET=$SELECT(NGET<0:-NGET,1:NGET)
+7 SET IND=""
SET NFOUND=0
+8 FOR
SET IND=$ORDER(ARCHDATA(IND),SDIR)
if (IND="")!(NFOUND=NGET)
QUIT
Begin DoDot:1
+9 SET NFOUND=NFOUND+1
+10 SET TEST(NFOUND)=$PIECE(ARCHDATA(IND),U,1)
+11 SET DATE(NFOUND)=$PIECE(ARCHDATA(IND),U,2)
+12 SET TEXT(NFOUND)=""
End DoDot:1
+13 QUIT
+14 ;
+15 ;==========================================================
LIST(NGET,BDT,EDT,PLIST,PARAM) ;List computed finding for building a list
+1 ;of ARCH eligible patients.
+2 NEW CNT,DATE,DFN,IND,NL,TEMP
+3 ;DBIA #5619
+4 SET NL=$$LIST^FBARCH0(BDT,EDT)
+5 FOR IND=1:1:NL
Begin DoDot:1
+6 SET TEMP=^TMP($JOB,"ARCHFEE",IND)
+7 ;Check eligibility.
+8 IF '$PIECE(TEMP,U,2)
QUIT
+9 SET DFN=$PIECE(TEMP,U,1)
SET DATE=$PIECE(TEMP,U,3)
+10 SET ^TMP($JOB,"TLIST",DFN,DATE)=""
End DoDot:1
+11 SET DFN=""
+12 FOR
SET DFN=$ORDER(^TMP($JOB,"TLIST",DFN))
if DFN=""
QUIT
Begin DoDot:1
+13 SET CNT=0
SET DATE=""
+14 FOR
SET DATE=$ORDER(^TMP($JOB,"TLIST",DFN,DATE))
if (DATE="")!(CNT=NGET)
QUIT
Begin DoDot:2
+15 SET CNT=CNT+1
SET ^TMP($JOB,PLIST,DFN,CNT)=U_DATE
End DoDot:2
End DoDot:1
+16 KILL ^TMP($JOB,"ARCHFEE"),^TMP($JOB,"TLIST")
+17 QUIT
+18 ;
+19 ;==========================================================
ISDUE(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multiple occurrence
+1 ; computed finding for a Project ARCH Reminder Custom Date Due.
+2 ; The $$GETDELAY^FBARCH0 API returns a site defined numeric value that represents
+3 ; the number of days to delay the reminder from being due again after
+4 ; being declined or refused through one of the related health factors.
+5 ;
+6 ; $$GETDELAY^FBARCH0 Supported by IA 5619
+7 ;
+8 NEW X,HFID,ARCHVHF,ARCHDLAY
+9 SET NFOUND=1
+10 SET ARCHDLAY=$$GETDELAY^FBARCH0()
+11 SET ARCHVHF($PIECE($$NOW^PXRMDATE(),"."))=""
+12 ; Get DECLINES and REFUSES Health Factor ID and last date created
+13 FOR X="DECLINES","REFUSES"
SET HFID=$ORDER(^AUTTHF("B","ARCH-SERVICE NEEDED THIS VISIT "_X,0))
Begin DoDot:1
+14 if '$DATA(^PXRMINDX(9000010.23,"PI",DFN,HFID))
QUIT
+15 ; Get date and add delay value
+16 SET ARCHVHF($$FMADD^XLFDT($PIECE($ORDER(^PXRMINDX(9000010.23,"PI",DFN,HFID," "),-1),"."),ARCHDLAY))=""
End DoDot:1
+17 SET TEST(NFOUND)=1
+18 SET TEXT(NFOUND)=""
+19 SET DATE(NFOUND)=$ORDER(ARCHVHF(" "),-1)
+20 QUIT
+21 ;
