PXRMCVRP.m

PXRMCVRP ;SLC/PKR - Cover sheet reminder report. ;01/22/2020

 ;;2.0;CLINICAL REMINDERS;**42**;Feb 04, 2005;Build 245

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

ADDCAT(CATIEN,IDX,IND,LIST,REMLIST) ;Add reminders in a Category to

 ;the list.

 N CATLIST,CATIDX,CATIND,DEC,JND,REMIEN

 D CATREM^PXRMAPI0(CATIEN,.CATLIST)

 S JND=0

 F  S JND=+$O(CATLIST(JND)) Q:JND=0  D

 . S DEC=.00001*JND

 . S CATIND=IND+DEC

 . S CATIDX=IDX+DEC

 . S REMIEN=CATLIST(JND)

 . S LIST(CATIND)=CATIDX_U_REMIEN

 . D ADDREM(REMIEN,CATIDX,CATIND,.LIST,.REMLIST)

 Q

 ;

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

ADDLIST(LIST,REMLIST) ;Add a list of reminders in the new parameter

 ;format to the final list.

 I '$D(LIST) Q

 N CODE,IEN,IDX,IND,TEMP

 S IND=0

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

 . S IDX=$P(LIST(IND),U,1)

 . S TEMP=$P(LIST(IND),U,2)

 . S CODE=$E(TEMP,2)

 . I CODE="R" S IEN=$P(TEMP,"R",2) D ADDREM(IEN,IDX,IND,.LIST,.REMLIST) Q

 . I CODE="C" S IEN=$P(TEMP,"C",2) D ADDCAT(IEN,IDX,IND,.LIST,.REMLIST)

 Q

 ;

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

ADDLISTO(LIST,REMLIST) ;Add a list of reminders in the old format to the

 ;final list.

 I '$D(LIST) Q

 N IEN,IDX,IND

 S IND=0

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

 . S IDX=$P(LIST(IND),U,1)

 . S IEN=$P(LIST(IND),U,2)

 . D ADDREM(IEN,IDX,IND,.LIST,.REMLIST)

 Q

 ;

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

ADDREM(IEN,IDX,IND,LIST,REMLIST) ;Add a reminder to the reminder list.

 ;If it is already on the reminder list don't add it again.

 I $D(REMLIST("IEN",IEN)) Q

 ;If it does not exist don't add it.

 I '$D(^PXD(811.9,IEN)) S $P(LIST(IND),U,3)="DOES NOT EXIST" Q

 ;If it is not active don't add it.

 I $P(^PXD(811.9,IEN,0),U,6)=1 S $P(LIST(IND),U,3)="INACTIVE" Q

 ;If it is not a cover sheet reminder don't add it.

 N USAGE

 S USAGE=$P(^PXD(811.9,IEN,100),U,4)

 I (USAGE["L")!(USAGE["O") S $P(LIST(IND),U,3)="NOT A COVER SHEET REMINDER" Q

 I (USAGE'["C")&(USAGE'["*") S $P(LIST(IND),U,3)="NOT A COVER SHEET REMINDER" Q

 S REMLIST(IDX)=IEN

 S REMLIST("IEN",IEN)=""

 Q

 ;

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

CPRSLIST(LIST,LVLLIST,USELECT) ;Build the cover sheet reminder list just like

 ;CPRS does.

 N ERR,LOCATION,LOCP,SERVICE,TLIST,TREMLIST,USER,USERP

 S LOCATION=USELECT("CPRS","LOCATION")

 S USER=USELECT("CPRS","USER")

 S LOCP=$P(LOCATION,U,1),USERP=$P(USER,U,1)

 D REMACCUM^PXRMCVRL(.LIST,"PKG","Q",1000)

 D REMACCUM^PXRMCVRL(.LIST,"SYS","Q",2000)

 D REMACCUM^PXRMCVRL(.LIST,"DIV","Q",3000)

 S SERVICE=$$GET1^DIQ(200,USERP,29,"I")

 I +SERVICE D

 . D REMACCUM^PXRMCVRL(.LIST,"SRV.`"_SERVICE,"Q",4000)

 . S USELECT("CPRS","SERVICE")=$$GET1^DIQ(200,USERP,29)

 I +LOCP D REMACCUM^PXRMCVRL(.LIST,"LOC.`"_LOCP,"Q",5000)

 D REMACCUM^PXRMCVRL(.LIST,"CLASS","Q",6000,"",USERP)

 D CPRSCVUC(USERP,.USELECT)

 D REMACCUM^PXRMCVRL(.LIST,"USR.`"_USERP,"Q",7000)

 D ADDLIST(.LIST,.TREMLIST) K TREMLIST("IEN")

 M REMLIST(LVLLIST(LI),"REM")=TREMLIST

 M REMLIST(LVLLIST(LI),"LIST")=LIST

 Q

 ;

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

CPRSCVUC(USER,USELECT) ;Return the cover sheet user classes the user is a

 ;member of.

 N CLASS,CLASSLIST,CLASSPARAM,ERR,IND

 S CLASSPARAM="ORQQPX COVER SHEET REM CLASSES"

 D GETLST^XPAR(.CLASSLIST,"SYS",CLASSPARAM,"Q",.ERR)

 S IND=0

 F  S IND=$O(CLASSLIST(IND)) Q:'IND  D

 . S CLASS=$P(CLASSLIST(IND),U,1)

 . I $$ISA^USRLM(USER,CLASS,.ERR) D

 .. S USELECT("CPRS","USER CLASS",CLASS)=$$CLNAME^USRLM(CLASS,1)

 Q

 ;

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

NEWRPP() ;Ask the user if they want to use the new reminder parameters.

 N DIR,DUOUT,DTOUT

 S DIR(0)="S^1:YES;2:NO"

 S DIR("B")="YES"

 W !,"Do you want to use the new reminder parameters?"

 D ^DIR

 I $D(DUOUT)!$D(DTOUT) Q 0

 Q $S(Y=1:1,Y=2:0)

 ;

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

NEWPARAM(LVLLIST,SELLIST,USELECT,REMLIST) ;Produce the reminder list using

 ;the new parameters.

 N ERR,IND,LI,LIST,TLIST,TREMLIST

 S LI=0

 F  S LI=$O(SELLIST(LI)) Q:LI=""  D

 . I LVLLIST(LI)="PACKAGE" D  Q

 .. D REMACCUM^PXRMCVRL(.LIST,"PKG","Q",1000)

 .. K TLIST,TREMLIST

 .. M TLIST=LIST D ADDLIST(.TLIST,.TREMLIST) K TREMLIST("IEN")

 .. M REMLIST(LVLLIST(LI),"REM")=TREMLIST

 .. M REMLIST(LVLLIST(LI),"LIST")=TLIST

 . I LVLLIST(LI)="SYSTEM" D  Q

 .. D REMACCUM^PXRMCVRL(.LIST,"SYS","Q",2000)

 .. K TLIST,TREMLIST

 .. M TLIST=LIST D ADDLIST(.TLIST,.TREMLIST) K TREMLIST("IEN")

 .. M REMLIST(LVLLIST(LI),"REM")=TREMLIST

 .. M REMLIST(LVLLIST(LI),"LIST")=TLIST

 . I LVLLIST(LI)="DIVISION" D  Q

 .. D REMACCUM^PXRMCVRL(.LIST,"DIV.`"_$P(USELECT(LI),U,1),"Q",3000)

 .. K TLIST,TREMLIST

 .. M TLIST=LIST D ADDLIST(.TLIST,.TREMLIST) K TREMLIST("IEN")

 .. M REMLIST(LVLLIST(LI),"REM")=TREMLIST

 .. M REMLIST(LVLLIST(LI),"LIST")=TLIST

 . I LVLLIST(LI)="SERVICE" D  Q

 .. D REMACCUM^PXRMCVRL(.LIST,"SRV.`"_$P(USELECT(LI),U,1),"Q",4000)

 .. K TLIST,TREMLIST

 .. M TLIST=LIST D ADDLIST(.TLIST,.TREMLIST) K TREMLIST("IEN")

 .. M REMLIST(LVLLIST(LI),"REM")=TREMLIST

 .. M REMLIST(LVLLIST(LI),"LIST")=TLIST

 . I LVLLIST(LI)="LOCATION" D  Q

 .. D REMACCUM^PXRMCVRL(.LIST,"LOC.`"_$P(USELECT(LI),U,1),"Q",5000)

 .. K TLIST,TREMLIST

 .. M TLIST=LIST D ADDLIST(.TLIST,.TREMLIST) K TREMLIST("IEN")

 .. M REMLIST(LVLLIST(LI),"REM")=TREMLIST

 .. M REMLIST(LVLLIST(LI),"LIST")=TLIST

 . I LVLLIST(LI)="USER CLASS" D  Q

 .. D REMACCUM^PXRMCVRL(.LIST,"CLASS","Q",6000,$P(USELECT(LI),U,1))

 .. K TLIST,TREMLIST

 .. M TLIST=LIST D ADDLIST(.TLIST,.TREMLIST) K TREMLIST("IEN")

 .. M REMLIST(LVLLIST(LI),"REM")=TREMLIST

 .. M REMLIST(LVLLIST(LI),"LIST")=TLIST

 . I LVLLIST(LI)="USER" D  Q

 .. D REMACCUM^PXRMCVRL(.LIST,"USR.`"_$P(USELECT(LI),U,1),"Q",7000)

 .. K TLIST,TREMLIST

 .. M TLIST=LIST D ADDLIST(.TLIST,.TREMLIST) K TREMLIST("IEN")

 .. M REMLIST(LVLLIST(LI),"REM")=TREMLIST

 .. M REMLIST(LVLLIST(LI),"LIST")=TLIST

 . I LVLLIST(LI)="CPRS" D CPRSLIST(.LIST,.LVLLIST,.USELECT)

 Q

 ;

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

NEWREMP(USER) ;

 N ERR,GBL,RESULT,SERVICE

 S SERVICE=$$GET1^DIQ(200,USER,29,"I")

 D GETLST^XPAR(.RESULT,"USR.`"_USER_"^SRV.`"_SERVICE_"^DIV^SYS^PKG","ORQQPX NEW REMINDER PARAMS","I",.ERR)

 Q RESULT

 ;

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

OLDPARAM(LVLLIST,SELLIST,USELECT,REMLIST) ;Produce the reminder list using

 ;the old parameters. Under the old parameters the list is built

 ;processing the entity string from left to right, it stops with

 ;the first item in the entity list that is populated. Then entity

 ;list is built in the order: USER, LOCATION, SERVICE, DIVISION,

 ;SYSTEM, PACKAGE.

 N DIVISION,ENTITY,ERR,IND,LI,LIST,LOCATION,SERVICE,TENTITY,USER

 S LI=0

 F  S LI=$O(SELLIST(LI)) Q:LI=""  D

 . I LVLLIST(LI)="PACKAGE" D  Q

 .. S $P(ENTITY,U,6)="PKG"

 .. K TENTITY

 .. S $P(TENTITY,U,6)="PKG"

 .. D OLDPARAML(LVLLIST(LI),TENTITY,.REMLIST)

 . I LVLLIST(LI)="SYSTEM"  D  Q

 .. S $P(ENTITY,U,5)="SYS"

 .. K TENTITY

 .. S $P(TENTITY,U,5)="SYS"

 .. D OLDPARAML(LVLLIST(LI),TENTITY,.REMLIST)

 . I LVLLIST(LI)="DIVISION" D  Q

 .. S DIVISION="DIV.`"_$P(USELECT(LI),U,1)

 .. S $P(ENTITY,U,4)=DIVISION

 .. K TENTITY

 .. S $P(TENTITY,U,4)=DIVISION

 .. D OLDPARAML(LVLLIST(LI),TENTITY,.REMLIST)

 . I LVLLIST(LI)="SERVICE" D  Q

 .. S SERVICE="SRV.`"_$P(USELECT(LI),U,1)

 .. S $P(ENTITY,U,3)=SERVICE

 .. K TENTITY

 .. S $P(TENTITY,U,3)=SERVICE

 .. D OLDPARAML(LVLLIST(LI),TENTITY,.REMLIST)

 . I LVLLIST(LI)="LOCATION" D  Q

 .. S LOCATION="LOC.`"_$P(USELECT(LI),U,1)

 .. S $P(ENTITY,U,2)=LOCATION

 .. K TENTITY

 .. S $P(TENTITY,U,2)=LOCATION

 .. D OLDPARAML(LVLLIST(LI),TENTITY,.REMLIST)

 . I LVLLIST(LI)="USER" D  Q

 .. S USER="USR.`"_$P(USELECT(LI),U,1)

 .. S $P(ENTITY,U,1)=USER

 .. K TENTITY

 .. S $P(TENTITY,U,1)=USER

 .. D OLDPARAML(LVLLIST(LI),TENTITY,.REMLIST)

 . I LVLLIST(LI)="CPRS" D

 .. S USER=USELECT("CPRS","USER")

 .. S LOCATION=USELECT("CPRS","LOCATION")

 .. S SERVICE=$$GET1^DIQ(200,$P(USER,U,1),29,"I")

 .. S ENTITY="USR.`"_$P(USER,U,1)_U_"LOC.`"_$P(LOCATION,U,1)_U_"SRV.`"_SERVICE_U_"DIV^SYS^PKG"

 .. D OLDPARAML(LVLLIST(LI),ENTITY,.REMLIST)

 D GETLST^XPAR(.LIST,ENTITY,"ORQQPX SEARCH ITEMS","Q",.ERR)

 D ADDLISTO(.LIST,.REMLIST) K REMLIST("IEN")

 Q

 ;

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

OLDPARAML(LEVEL,ENTITY,REMLIST) ;Create the old parameter list at a

 ;specific level.

 N LIST,TREMLIST

 D GETLST^XPAR(.LIST,ENTITY,"ORQQPX SEARCH ITEMS","Q",.ERR)

 D ADDLISTO(.LIST,.TREMLIST) K TREMLIST("IEN")

 M REMLIST(LEVEL,"REM")=TREMLIST

 M REMLIST(LEVEL,"LIST")=LIST

 Q

 ;

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

REPD ;Main report driver.

 N DONE,LI,LVLLIST,NEWRP,NUM,REMLIST,SELLIST,USELDONE,USELECT

 S DONE=0

 W !,"Clinical Reminders Cover Sheet Reminder List Report"

 S NEWRP=$$NEWRPP

 F  Q:DONE  D

 .;Get a list of levels for the report.

 . D SELLIST(NEWRP,.LVLLIST,.SELLIST)

 . I '$D(SELLIST) S DONE=1 Q

 . K REMLIST,USELECT

 . S (LI,USELDONE)=0

 . F  S LI=$O(SELLIST(LI)) Q:(LI="")!(USELDONE)  D

 .. I LVLLIST(LI)="DIVISION" D  Q

 ... S USELECT(LI)=$$SELECT(4,"Select the division: ")

 ... I USELECT(LI)=-1 S USELDONE=1

 .. I LVLLIST(LI)="SERVICE" D  Q

 ... S USELECT(LI)=$$SELECT(49,"Select the service: ")

 ... I USELECT(LI)=-1 S USELDONE=1

 .. I LVLLIST(LI)="LOCATION" D  Q

 ... S USELECT(LI)=$$SELECT(44,"Select the location: ")

 ... I USELECT(LI)=-1 S USELDONE=1

 .. I LVLLIST(LI)="USER CLASS" D  Q

 ... S USELECT(LI)=$$SELECT(8930,"Select the user class: ")

 ... I USELECT(LI)=-1 S USELDONE=1

 .. I LVLLIST(LI)="USER" D  Q

 ... S USELECT(LI)=$$SELECT(200,"Select the user: ")

 ... I USELECT(LI)=-1 S USELDONE=1

 .. I LVLLIST(LI)="CPRS" D  Q

 ... S USELECT("CPRS","USER")=$$SELECT(200,"Select the user: ")

 ... I USELECT("CPRS","USER")=-1 S USELDONE=1 Q

 ... S USELECT("CPRS","LOCATION")=$$SELECT(44,"Select the location: ")

 ... I USELECT("CPRS","LOCATION")=-1 S USELDONE=1

 . I USELDONE=1 Q

 . I NEWRP D NEWPARAM(.LVLLIST,.SELLIST,.USELECT,.REMLIST)

 . I 'NEWRP D OLDPARAM(.LVLLIST,.SELLIST,.USELECT,.REMLIST)

 . K REMLIST("IEN")

 .;Produce the report.

 . D REPORT(NEWRP,.LVLLIST,.SELLIST,.USELECT,.REMLIST)

 Q

 ;

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

REPORT(NEWRP,LVLLIST,SELLIST,USELECT,REMLIST) ;Generate the report.

 N BOP,FIRST,IEN,IND,NDEF,NL,LEVELS,LI,OUTPUT,SELECT,TEMP

 S NL=0

 S NL=NL+1,OUTPUT(NL)="Report Criteria"

 S NL=NL+1,OUTPUT(NL)="Use new cover sheet parameters: "_$S(NEWRP=1:"YES",1:"NO")

 S NL=NL+1,OUTPUT(NL)="Selected levels:"

 S LI=0

 F  S LI=$O(SELLIST(LI)) Q:LI=""  D

 . S NL=NL+1,OUTPUT(NL)=" "_LVLLIST(LI)

 . S SELECT=$G(USELECT(LI))

 . I SELECT=-1 S NL=NL+1,OUTPUT(NL)="  Value - No selection"

 . I $P(SELECT,U,2)'=""  S NL=NL+1,OUTPUT(NL)="  Value - "_$P(SELECT,U,2)

 . I LVLLIST(LI)="CPRS" D

 .. S NL=NL+1,OUTPUT(NL)="  User - "_$P(USELECT("CPRS","USER"),U,2)

 .. S NL=NL+1,OUTPUT(NL)="  Location - "_$P(USELECT("CPRS","LOCATION"),U,2)

 .. I 'NEWRP Q

 .. S NL=NL+1,OUTPUT(NL)="  Service - "_USELECT("CPRS","SERVICE")

 .. S IND=0

 .. F  S IND=$O(USELECT("CPRS","USER CLASS",IND)) Q:IND=""  D

 ... S NL=NL+1,OUTPUT(NL)="  User Class - "_USELECT("CPRS","USER CLASS",IND)

 S NL=NL+1,OUTPUT(NL)=""

 S FIRST=$O(SELLIST(0))

 S LEVELS="",LI=0

 F  S LI=$O(SELLIST(LI)) Q:LI=""  D

 . S NL=NL+1,OUTPUT(NL)=""

 . I NEWRP D

 .. I LI>FIRST S LEVELS=LEVELS_","

 .. S LEVELS=LEVELS_" "_LVLLIST(LI)

 .. S NL=NL+1,OUTPUT(NL)="Reminder list at"_LEVELS

 .. S OUTPUT(NL)=OUTPUT(NL)_$S(LI=FIRST:" level",1:" levels")

 . I 'NEWRP D

 .. S LEVELS=LVLLIST(LI)

 .. S NL=NL+1,OUTPUT(NL)="Reminder list at the "_LEVELS_" level"

 . S IND=0

 . F  S IND=+$O(REMLIST(LVLLIST(LI),"LIST",IND)) Q:IND=0  D

 .. S NL=NL+1,OUTPUT(NL)="LIST("_IND_")="_REMLIST(LVLLIST(LI),"LIST",IND)

 . S IND="",NDEF=0

 . S NL=NL+1,OUTPUT(NL)=""

 . S NL=NL+1,OUTPUT(NL)="Reminders in Display Order"

 . F  S IND=$O(REMLIST(LVLLIST(LI),"REM",IND)) Q:IND=""  D

 .. S NDEF=NDEF+1

 .. S IEN=REMLIST(LVLLIST(LI),"REM",IND)

 .. S TEMP=^PXD(811.9,IEN,0)

 .. I NDEF>1 S NL=NL+1,OUTPUT(NL)=""

 .. S NL=NL+1,OUTPUT(NL)="Name - "_$P(TEMP,U,1)_"  (IEN="_IEN_")"

 .. S NL=NL+1,OUTPUT(NL)="Print Name - "_$P(TEMP,U,3)

 . S NL=NL+1,OUTPUT(NL)=""

 . S NL=NL+1,OUTPUT(NL)="There are "_NDEF_" reminders on the list."

 I 'NEWRP,'$D(REMLIST("CPRS")) D

 . S NL=NL+1,OUTPUT(NL)=""

 . S NL=NL+1,OUTPUT(NL)="Final Reminder List"

 . S IND=0,NDEF=0

 .F  S IND=+$O(REMLIST(IND)) Q:IND=0  D

 .. S NDEF=NDEF+1

 .. S IEN=REMLIST(IND)

 .. S TEMP=^PXD(811.9,IEN,0)

 .. I NDEF>1 S NL=NL+1,OUTPUT(NL)=""

 .. S NL=NL+1,OUTPUT(NL)="Name - "_$P(TEMP,U,1)

 .. S NL=NL+1,OUTPUT(NL)="Print Name - "_$P(TEMP,U,3)

 . S NL=NL+1,OUTPUT(NL)=""

 . S NL=NL+1,OUTPUT(NL)="There are "_NDEF_" reminders on the list."

 . S NL=NL+1,OUTPUT(NL)=""

 S BOP=$$BORP^PXRMUTIL("B")

 I BOP="B" D

 . S X="IORESET"

 . D ENDR^%ZISS

 . D BROWSE^DDBR("OUTPUT","NR","CPRS Cover Sheet Reminder List")

 . W IORESET

 . D KILL^%ZISS

 I BOP="P" D GPRINT^PXRMUTIL("OUTPUT")

 Q

 ;

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

SELECT(FILENUM,PROMPT) ;Let the user make a selection.

 N DIC,DONE,X,Y

 S DIC=FILENUM,DIC(0)="AEO"

 S DIC("A")=PROMPT

 S DONE=0

 F  Q:DONE  D

 . D ^DIC

 . I X'="" S DONE=1

 Q Y

 ;

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

SELLIST(NEWRP,LVLLIST,OLIST) ;Build a list of selections and let the user

 ;select from the list.

 N CPRSLVL,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IND,NLVL,SELLIST,X,Y

 K OLIST

 S NLVL=0

 S NLVL=NLVL+1,SELLIST(NLVL)=" "_$J(NLVL,4)_" - PACKAGE",LVLLIST(NLVL)="PACKAGE"

 S NLVL=NLVL+1,SELLIST(NLVL)=" "_$J(NLVL,4)_" - SYSTEM",LVLLIST(NLVL)="SYSTEM"

 S NLVL=NLVL+1,SELLIST(NLVL)=" "_$J(NLVL,4)_" - DIVISION",LVLLIST(NLVL)="DIVISION"

 S NLVL=NLVL+1,SELLIST(NLVL)=" "_$J(NLVL,4)_" - SERVICE",LVLLIST(NLVL)="SERVICE"

 S NLVL=NLVL+1,SELLIST(NLVL)=" "_$J(NLVL,4)_" - LOCATION",LVLLIST(NLVL)="LOCATION"

 I NEWRP S NLVL=NLVL+1,SELLIST(NLVL)=" "_$J(NLVL,4)_" - USER CLASS",LVLLIST(NLVL)="USER CLASS"

 S NLVL=NLVL+1,SELLIST(NLVL)=" "_$J(NLVL,4)_" - USER",LVLLIST(NLVL)="USER"

 S NLVL=NLVL+1,SELLIST(NLVL)=" "_$J(NLVL,4)_" - CPRS",LVLLIST(NLVL)="CPRS"

 S CPRSLVL=NLVL

 M DIR("A")=SELLIST

 S DIR("A")="Enter your list for the report"

 S DIR(0)="LO^1:"_NLVL

 W !!,"Select from the following levels:"

 D ^DIR

 I $D(DIROUT)!$D(DIRUT) K OLIST Q

 I $D(DUOUT)!$D(DTOUT) K OLIST Q

 ;If the list contains CPRS only return CPRS.

 I Y[CPRSLVL S Y=CPRSLVL_","

 ;Make sure the list is ordered.

 F IND=1:1:$L(Y,",")-1 S OLIST($P(Y,",",IND))=""

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXRMCVRP   14346     printed  Apr 23, 2025@17:57:52                                                                                                                                                                                                   Page 2

PXRMCVRP  ;SLC/PKR - Cover sheet reminder report. ;01/22/2020

 +1       ;;2.0;CLINICAL REMINDERS;**42**;Feb 04, 2005;Build 245

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

ADDCAT(CATIEN,IDX,IND,LIST,REMLIST) ;Add reminders in a Category to

 +1       ;the list.

 +2        NEW CATLIST,CATIDX,CATIND,DEC,JND,REMIEN

 +3        DO CATREM^PXRMAPI0(CATIEN,.CATLIST)

 +4        SET JND=0

 +5        FOR 

               SET JND=+$ORDER(CATLIST(JND))

               if JND=0

                   QUIT 

               Begin DoDot:1

 +6                SET DEC=.00001*JND

 +7                SET CATIND=IND+DEC

 +8                SET CATIDX=IDX+DEC

 +9                SET REMIEN=CATLIST(JND)

 +10               SET LIST(CATIND)=CATIDX_U_REMIEN

 +11               DO ADDREM(REMIEN,CATIDX,CATIND,.LIST,.REMLIST)

               End DoDot:1

 +12       QUIT 

 +13      ;

 +14      ;==============================

ADDLIST(LIST,REMLIST) ;Add a list of reminders in the new parameter

 +1       ;format to the final list.

 +2        IF '$DATA(LIST)

               QUIT 

 +3        NEW CODE,IEN,IDX,IND,TEMP

 +4        SET IND=0

 +5        FOR 

               SET IND=+$ORDER(LIST(IND))

               if IND=0

                   QUIT 

               Begin DoDot:1

 +6                SET IDX=$PIECE(LIST(IND),U,1)

 +7                SET TEMP=$PIECE(LIST(IND),U,2)

 +8                SET CODE=$EXTRACT(TEMP,2)

 +9                IF CODE="R"

                       SET IEN=$PIECE(TEMP,"R",2)

                       DO ADDREM(IEN,IDX,IND,.LIST,.REMLIST)

                       QUIT 

 +10               IF CODE="C"

                       SET IEN=$PIECE(TEMP,"C",2)

                       DO ADDCAT(IEN,IDX,IND,.LIST,.REMLIST)

               End DoDot:1

 +11       QUIT 

 +12      ;

 +13      ;==============================

ADDLISTO(LIST,REMLIST) ;Add a list of reminders in the old format to the

 +1       ;final list.

 +2        IF '$DATA(LIST)

               QUIT 

 +3        NEW IEN,IDX,IND

 +4        SET IND=0

 +5        FOR 

               SET IND=+$ORDER(LIST(IND))

               if IND=0

                   QUIT 

               Begin DoDot:1

 +6                SET IDX=$PIECE(LIST(IND),U,1)

 +7                SET IEN=$PIECE(LIST(IND),U,2)

 +8                DO ADDREM(IEN,IDX,IND,.LIST,.REMLIST)

               End DoDot:1

 +9        QUIT 

 +10      ;

 +11      ;==============================

ADDREM(IEN,IDX,IND,LIST,REMLIST) ;Add a reminder to the reminder list.

 +1       ;If it is already on the reminder list don't add it again.

 +2        IF $DATA(REMLIST("IEN",IEN))

               QUIT 

 +3       ;If it does not exist don't add it.

 +4        IF '$DATA(^PXD(811.9,IEN))

               SET $PIECE(LIST(IND),U,3)="DOES NOT EXIST"

               QUIT 

 +5       ;If it is not active don't add it.

 +6        IF $PIECE(^PXD(811.9,IEN,0),U,6)=1

               SET $PIECE(LIST(IND),U,3)="INACTIVE"

               QUIT 

 +7       ;If it is not a cover sheet reminder don't add it.

 +8        NEW USAGE

 +9        SET USAGE=$PIECE(^PXD(811.9,IEN,100),U,4)

 +10       IF (USAGE["L")!(USAGE["O")

               SET $PIECE(LIST(IND),U,3)="NOT A COVER SHEET REMINDER"

               QUIT 

 +11       IF (USAGE'["C")&(USAGE'["*")

               SET $PIECE(LIST(IND),U,3)="NOT A COVER SHEET REMINDER"

               QUIT 

 +12       SET REMLIST(IDX)=IEN

 +13       SET REMLIST("IEN",IEN)=""

 +14       QUIT 

 +15      ;

 +16      ;==============================

CPRSLIST(LIST,LVLLIST,USELECT) ;Build the cover sheet reminder list just like

 +1       ;CPRS does.

 +2        NEW ERR,LOCATION,LOCP,SERVICE,TLIST,TREMLIST,USER,USERP

 +3        SET LOCATION=USELECT("CPRS","LOCATION")

 +4        SET USER=USELECT("CPRS","USER")

 +5        SET LOCP=$PIECE(LOCATION,U,1)

           SET USERP=$PIECE(USER,U,1)

 +6        DO REMACCUM^PXRMCVRL(.LIST,"PKG","Q",1000)

 +7        DO REMACCUM^PXRMCVRL(.LIST,"SYS","Q",2000)

 +8        DO REMACCUM^PXRMCVRL(.LIST,"DIV","Q",3000)

 +9        SET SERVICE=$$GET1^DIQ(200,USERP,29,"I")

 +10       IF +SERVICE

               Begin DoDot:1

 +11               DO REMACCUM^PXRMCVRL(.LIST,"SRV.`"_SERVICE,"Q",4000)

 +12               SET USELECT("CPRS","SERVICE")=$$GET1^DIQ(200,USERP,29)

               End DoDot:1

 +13       IF +LOCP

               DO REMACCUM^PXRMCVRL(.LIST,"LOC.`"_LOCP,"Q",5000)

 +14       DO REMACCUM^PXRMCVRL(.LIST,"CLASS","Q",6000,"",USERP)

 +15       DO CPRSCVUC(USERP,.USELECT)

 +16       DO REMACCUM^PXRMCVRL(.LIST,"USR.`"_USERP,"Q",7000)

 +17       DO ADDLIST(.LIST,.TREMLIST)

           KILL TREMLIST("IEN")

 +18       MERGE REMLIST(LVLLIST(LI),"REM")=TREMLIST

 +19       MERGE REMLIST(LVLLIST(LI),"LIST")=LIST

 +20       QUIT 

 +21      ;

 +22      ;==============================

CPRSCVUC(USER,USELECT) ;Return the cover sheet user classes the user is a

 +1       ;member of.

 +2        NEW CLASS,CLASSLIST,CLASSPARAM,ERR,IND

 +3        SET CLASSPARAM="ORQQPX COVER SHEET REM CLASSES"

 +4        DO GETLST^XPAR(.CLASSLIST,"SYS",CLASSPARAM,"Q",.ERR)

 +5        SET IND=0

 +6        FOR 

               SET IND=$ORDER(CLASSLIST(IND))

               if 'IND

                   QUIT 

               Begin DoDot:1

 +7                SET CLASS=$PIECE(CLASSLIST(IND),U,1)

 +8                IF $$ISA^USRLM(USER,CLASS,.ERR)

                       Begin DoDot:2

 +9                        SET USELECT("CPRS","USER CLASS",CLASS)=$$CLNAME^USRLM(CLASS,1)

                       End DoDot:2

               End DoDot:1

 +10       QUIT 

 +11      ;

 +12      ;==============================

NEWRPP()  ;Ask the user if they want to use the new reminder parameters.

 +1        NEW DIR,DUOUT,DTOUT

 +2        SET DIR(0)="S^1:YES;2:NO"

 +3        SET DIR("B")="YES"

 +4        WRITE !,"Do you want to use the new reminder parameters?"

 +5        DO ^DIR

 +6        IF $DATA(DUOUT)!$DATA(DTOUT)

               QUIT 0

 +7        QUIT $SELECT(Y=1:1,Y=2:0)

 +8       ;

 +9       ;==============================

NEWPARAM(LVLLIST,SELLIST,USELECT,REMLIST) ;Produce the reminder list using

 +1       ;the new parameters.

 +2        NEW ERR,IND,LI,LIST,TLIST,TREMLIST

 +3        SET LI=0

 +4        FOR 

               SET LI=$ORDER(SELLIST(LI))

               if LI=""

                   QUIT 

               Begin DoDot:1

 +5                IF LVLLIST(LI)="PACKAGE"

                       Begin DoDot:2

 +6                        DO REMACCUM^PXRMCVRL(.LIST,"PKG","Q",1000)

 +7                        KILL TLIST,TREMLIST

 +8                        MERGE TLIST=LIST

                           DO ADDLIST(.TLIST,.TREMLIST)

                           KILL TREMLIST("IEN")

 +9                        MERGE REMLIST(LVLLIST(LI),"REM")=TREMLIST

 +10                       MERGE REMLIST(LVLLIST(LI),"LIST")=TLIST

                       End DoDot:2

                       QUIT 

 +11               IF LVLLIST(LI)="SYSTEM"

                       Begin DoDot:2

 +12                       DO REMACCUM^PXRMCVRL(.LIST,"SYS","Q",2000)

 +13                       KILL TLIST,TREMLIST

 +14                       MERGE TLIST=LIST

                           DO ADDLIST(.TLIST,.TREMLIST)

                           KILL TREMLIST("IEN")

 +15                       MERGE REMLIST(LVLLIST(LI),"REM")=TREMLIST

 +16                       MERGE REMLIST(LVLLIST(LI),"LIST")=TLIST

                       End DoDot:2

                       QUIT 

 +17               IF LVLLIST(LI)="DIVISION"

                       Begin DoDot:2

 +18                       DO REMACCUM^PXRMCVRL(.LIST,"DIV.`"_$PIECE(USELECT(LI),U,1),"Q",3000)

 +19                       KILL TLIST,TREMLIST

 +20                       MERGE TLIST=LIST

                           DO ADDLIST(.TLIST,.TREMLIST)

                           KILL TREMLIST("IEN")

 +21                       MERGE REMLIST(LVLLIST(LI),"REM")=TREMLIST

 +22                       MERGE REMLIST(LVLLIST(LI),"LIST")=TLIST

                       End DoDot:2

                       QUIT 

 +23               IF LVLLIST(LI)="SERVICE"

                       Begin DoDot:2

 +24                       DO REMACCUM^PXRMCVRL(.LIST,"SRV.`"_$PIECE(USELECT(LI),U,1),"Q",4000)

 +25                       KILL TLIST,TREMLIST

 +26                       MERGE TLIST=LIST

                           DO ADDLIST(.TLIST,.TREMLIST)

                           KILL TREMLIST("IEN")

 +27                       MERGE REMLIST(LVLLIST(LI),"REM")=TREMLIST