PXRMASU.m

PXRMASU ;SLC/PKR - Clinical Reminder ASU routines. ;01/29/2010

 ;;2.0;CLINICAL REMINDERS;**17**;Feb 04, 2005;Build 102

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

CLASS(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding

 ;for user class. Use of USRLM covered by DBIA #2324.

 S NFOUND=0

 Q:NGET=0

 N CLASSOK,CLIST,CNAME,EFFDATE,EXPDATE,FEFFDATE,DONE,IND,JND,LIST

 N NOCC,OLIST,OVERLAP,SDIR,TCLASS,USER

 S TCLASS=TEST

 S USER=DUZ

 D WHATIS^USRLM(USER,"LIST",1)

 ;Order the list by Effective Date.

 S IND=0

 F  S IND=$O(LIST(IND)) Q:IND=""  D

 . S EFFDATE=+$P(LIST(IND),U,4),EXPDATE=$P(LIST(IND),U,5)

 . I EXPDATE="" S EXPDATE=$$NOW^PXRMDATE

 .;Only keep the entries whose date range, defined by Effective Date

 .;and Expiration Date is in the date range defined by BDT and EDT.

 . I $$OVERLAP^PXRMINDX(EFFDATE,EXPDATE,BDT,EDT)'="O" Q

 .;If TCLASS is not null then check for membership in the specified

 .;class or subclass.

 . S CLASSOK=$S(TCLASS="":1,TCLASS=$P(LIST(IND),U,3):1,1:$$SUBCLASS^USRLM($P(LIST(IND),U,1),TCLASS))

 . I CLASSOK S JND(EFFDATE)=+$G(JND(EFFDATE))+1,OLIST(EFFDATE,JND(EFFDATE))=LIST(IND)

 S SDIR=$S(NGET>0:-1,1:1)

 S NOCC=$S(NGET>0:NGET,1:-NGET)

 S DONE=0,EFFDATE=""

 F  S EFFDATE=$O(OLIST(EFFDATE),SDIR) Q:(DONE)!(EFFDATE="")  D

 . S IND=0

 . F  S IND=$O(OLIST(EFFDATE,IND)) Q:(DONE)!(IND="")  D

 .. S CNAME=$P(OLIST(EFFDATE,IND),U,3)

 .. S EXPDATE=$P(OLIST(EFFDATE,IND),U,5)

 .. S NFOUND=NFOUND+1

 .. I NFOUND=NOCC S DONE=1

 .. S TEST(NFOUND)=1

 .. S DATE(NFOUND)=EFFDATE

 .. S DATA(NFOUND,"ASU CLASS")=CNAME

 .. S DATA(NFOUND,"EFFECTIVE DATE")=EFFDATE

 .. S DATA(NFOUND,"EXPIRATION DATE")=EXPDATE

 .. S FEFFDATE=$S(EFFDATE=0:"00/00/0000",1:$$FMTE^XLFDT(EFFDATE,"5Z"))

 .. I EXPDATE'="" S EXPDATE=$$EDATE^PXRMDATE(EXPDATE)

 .. S TEXT(NFOUND)=CNAME_" ("_FEFFDATE_" - "_EXPDATE_")"

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXRMASU   1882     printed  Feb 18, 2025@23:09:25                                                                                                                                                                                                     Page 2

PXRMASU   ;SLC/PKR - Clinical Reminder ASU routines. ;01/29/2010

 +1       ;;2.0;CLINICAL REMINDERS;**17**;Feb 04, 2005;Build 102

 +2       ;==========================================================

CLASS(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Computed finding

 +1       ;for user class. Use of USRLM covered by DBIA #2324.

 +2        SET NFOUND=0

 +3        if NGET=0

               QUIT 

 +4        NEW CLASSOK,CLIST,CNAME,EFFDATE,EXPDATE,FEFFDATE,DONE,IND,JND,LIST

 +5        NEW NOCC,OLIST,OVERLAP,SDIR,TCLASS,USER

 +6        SET TCLASS=TEST

 +7        SET USER=DUZ

 +8        DO WHATIS^USRLM(USER,"LIST",1)

 +9       ;Order the list by Effective Date.

 +10       SET IND=0

 +11       FOR 

               SET IND=$ORDER(LIST(IND))

               if IND=""

                   QUIT 

               Begin DoDot:1

 +12               SET EFFDATE=+$PIECE(LIST(IND),U,4)

                   SET EXPDATE=$PIECE(LIST(IND),U,5)

 +13               IF EXPDATE=""

                       SET EXPDATE=$$NOW^PXRMDATE

 +14      ;Only keep the entries whose date range, defined by Effective Date

 +15      ;and Expiration Date is in the date range defined by BDT and EDT.

 +16               IF $$OVERLAP^PXRMINDX(EFFDATE,EXPDATE,BDT,EDT)'="O"

                       QUIT 

 +17      ;If TCLASS is not null then check for membership in the specified

 +18      ;class or subclass.

 +19               SET CLASSOK=$SELECT(TCLASS="":1,TCLASS=$PIECE(LIST(IND),U,3):1,1:$$SUBCLASS^USRLM($PIECE(LIST(IND),U,1),TCLASS))

 +20               IF CLASSOK

                       SET JND(EFFDATE)=+$GET(JND(EFFDATE))+1

                       SET OLIST(EFFDATE,JND(EFFDATE))=LIST(IND)

               End DoDot:1

 +21       SET SDIR=$SELECT(NGET>0:-1,1:1)

 +22       SET NOCC=$SELECT(NGET>0:NGET,1:-NGET)

 +23       SET DONE=0

           SET EFFDATE=""

 +24       FOR 

               SET EFFDATE=$ORDER(OLIST(EFFDATE),SDIR)

               if (DONE)!(EFFDATE="")

                   QUIT 

               Begin DoDot:1

 +25               SET IND=0

 +26               FOR 

                       SET IND=$ORDER(OLIST(EFFDATE,IND))

                       if (DONE)!(IND="")

                           QUIT 

                       Begin DoDot:2

 +27                       SET CNAME=$PIECE(OLIST(EFFDATE,IND),U,3)

 +28                       SET EXPDATE=$PIECE(OLIST(EFFDATE,IND),U,5)

 +29                       SET NFOUND=NFOUND+1

 +30                       IF NFOUND=NOCC

                               SET DONE=1

 +31                       SET TEST(NFOUND)=1

 +32                       SET DATE(NFOUND)=EFFDATE

 +33                       SET DATA(NFOUND,"ASU CLASS")=CNAME

 +34                       SET DATA(NFOUND,"EFFECTIVE DATE")=EFFDATE

 +35                       SET DATA(NFOUND,"EXPIRATION DATE")=EXPDATE

 +36                       SET FEFFDATE=$SELECT(EFFDATE=0:"00/00/0000",1:$$FMTE^XLFDT(EFFDATE,"5Z"))

 +37                       IF EXPDATE'=""

                               SET EXPDATE=$$EDATE^PXRMDATE(EXPDATE)

 +38                       SET TEXT(NFOUND)=CNAME_" ("_FEFFDATE_" - "_EXPDATE_")"

                       End DoDot:2

               End DoDot:1

 +39       QUIT 

 +40      ;