Routine: PXRMARCH

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

 ;==========================================================

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

 ;==========================================================

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)

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      ;

PXRMARCH.m