PXRMXS1.m

PXRMXS1 ; SLC/PJH - Reminder Reports DIC Prompts;10/11/2001

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 ;

 ;

 ;Check for category reminders

 ;----------------------------

FOUND(CIEN) ;

 N DATA,FOUND,RIEN,SUB

 S FOUND=0,SUB=0

 F  S SUB=$O(^PXRMD(811.7,CIEN,2,SUB)) Q:SUB=""  D  Q:FOUND

 .S DATA=$G(^PXRMD(811.7,CIEN,2,SUB,0)) Q:DATA=""

 .S RIEN=$P(DATA,U) Q:RIEN=""

 .;Ignore disabled reminders

 .I '$P($G(^PXD(811.9,RIEN,0)),U,6) S FOUND=1

 Q FOUND

 ;

 ;Add reminder category reminders to reminder array

 ;-------------------------------------------------

MERGE N RCIEN,RCNT,RCSUB,RIEN,RPNAM,RSUB,SUB

 K ^TMP("PXRMXS1",$J)

 K REMINDER

 ;Extract each category in turn

 S RCSUB=""

 F  S RCSUB=$O(PXRMRCAT(RCSUB)) Q:'RCSUB  D

 .S RCIEN=$P(PXRMRCAT(RCSUB),U) Q:'RCIEN

 .;Add category reminders to reminder array

 .D MREM(RCIEN,.REMINDER)

 ;

 ;Add individual reminders at the end

 S SUB="",RSUB=+$O(REMINDER(""),-1)

 F  S SUB=$O(PXRMREM(SUB)) Q:'SUB  D

 .;Ignore duplicates

 .S RIEN=$P(PXRMREM(SUB),U) Q:'RIEN  Q:$D(^TMP("PXRMXS1",$J,RIEN))

 .S RSUB=RSUB+1,REMINDER(RSUB)=PXRMREM(SUB),^TMP("PXRMXS1",$J,RIEN)=""

 ;

 K ^TMP("PXRMXS1",$J)

 Q

 ;

MREM(CIEN,REM) ;Add to output array

 N DATA,NAME,NREM,RIEN,PNAME,SEQ,SUB,TEMP

 ;Add to end of list

 S NREM=+$O(REM(""),-1)

 ;

 ;Sort Reminders from this category into display sequence

 S SUB=0 K TEMP

 F  S SUB=$O(^PXRMD(811.7,CIEN,2,SUB)) Q:SUB=""  D

 .S DATA=$G(^PXRMD(811.7,CIEN,2,SUB,0)) Q:DATA=""

 .;Ignore duplicates

 .S RIEN=$P(DATA,U) Q:RIEN=""  Q:$D(^TMP("PXRMXS1",$J,RIEN))

 .S SEQ=$P(DATA,U,2)_0

 .S DATA=$G(^PXD(811.9,RIEN,0))

 .S NAME=$P(DATA,U),PNAME=$P(DATA,U,3)

 .S TEMP(SEQ)=RIEN_U_NAME_U_NAME_U_PNAME

 .S ^TMP("PXRMXS1",$J,RIEN)=""

 ;

 ;Re-save reminders in output array for display

 ;unique number^type^name^parent^reminder ien

 ;

 S SEQ=""

 F  S SEQ=$O(TEMP(SEQ)) Q:SEQ=""  D

 .S NREM=NREM+1,REM(NREM)=TEMP(SEQ)

 ;

 ;Sort Sub-Categories for this category into display order

 S SUB=0 K TEMP

 F  S SUB=$O(^PXRMD(811.7,CIEN,10,SUB)) Q:SUB=""  D

 .S DATA=$G(^PXRMD(811.7,CIEN,10,SUB,0)) Q:DATA=""

 .S SEQ=$P(DATA,U,2),TEMP(SEQ)=SUB

 ;

 ;Process sub-sub categories in the same manner

 S SEQ=""

 F  S SEQ=$O(TEMP(SEQ)) Q:SEQ=""  D

 .N IEN

 .S SUB=TEMP(SEQ),IEN=$P($G(^PXRMD(811.7,CIEN,10,SUB,0)),U) Q:'IEN

 .D MREM(IEN,.REM)

 Q

 ;

 ;Check if a category has any sub-categories

 ;------------------------------------------

OK(CIEN) ;

 ;Check in reminder multiple

 I $$FOUND(CIEN) Q 1

 ;

 ;Otherwise check the sub-categories

 N DATA,FOUND,IEN,SUB

 S FOUND=0,SUB=0

 F  S SUB=$O(^PXRMD(811.7,CIEN,10,SUB)) Q:SUB=""  D  Q:FOUND

 .S DATA=$G(^PXRMD(811.7,CIEN,10,SUB,0)) Q:DATA=""

 .S IEN=$P(DATA,U) Q:'IEN

 .;Check for active reminders in reminder multiple

 .S FOUND=$$FOUND(IEN)

 Q FOUND

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXRMXS1   2821     printed  Mar 13, 2025@20:54:56                                                                                                                                                                                                     Page 2

PXRMXS1   ; SLC/PJH - Reminder Reports DIC Prompts;10/11/2001

 +1       ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 +2       ;

 +3       ;

 +4       ;Check for category reminders

 +5       ;----------------------------

FOUND(CIEN) ;

 +1        NEW DATA,FOUND,RIEN,SUB

 +2        SET FOUND=0

           SET SUB=0

 +3        FOR 

               SET SUB=$ORDER(^PXRMD(811.7,CIEN,2,SUB))

               if SUB=""

                   QUIT 

               Begin DoDot:1

 +4                SET DATA=$GET(^PXRMD(811.7,CIEN,2,SUB,0))

                   if DATA=""

                       QUIT 

 +5                SET RIEN=$PIECE(DATA,U)

                   if RIEN=""

                       QUIT 

 +6       ;Ignore disabled reminders

 +7                IF '$PIECE($GET(^PXD(811.9,RIEN,0)),U,6)

                       SET FOUND=1

               End DoDot:1

               if FOUND

                   QUIT 

 +8        QUIT FOUND

 +9       ;

 +10      ;Add reminder category reminders to reminder array

 +11      ;-------------------------------------------------

MERGE      NEW RCIEN,RCNT,RCSUB,RIEN,RPNAM,RSUB,SUB

 +1        KILL ^TMP("PXRMXS1",$JOB)

 +2        KILL REMINDER

 +3       ;Extract each category in turn

 +4        SET RCSUB=""

 +5        FOR 

               SET RCSUB=$ORDER(PXRMRCAT(RCSUB))

               if 'RCSUB

                   QUIT 

               Begin DoDot:1

 +6                SET RCIEN=$PIECE(PXRMRCAT(RCSUB),U)

                   if 'RCIEN

                       QUIT 

 +7       ;Add category reminders to reminder array

 +8                DO MREM(RCIEN,.REMINDER)

               End DoDot:1

 +9       ;

 +10      ;Add individual reminders at the end

 +11       SET SUB=""

           SET RSUB=+$ORDER(REMINDER(""),-1)

 +12       FOR 

               SET SUB=$ORDER(PXRMREM(SUB))

               if 'SUB

                   QUIT 

               Begin DoDot:1

 +13      ;Ignore duplicates

 +14               SET RIEN=$PIECE(PXRMREM(SUB),U)

                   if 'RIEN

                       QUIT 

                   if $DATA(^TMP("PXRMXS1",$JOB,RIEN))

                       QUIT 

 +15               SET RSUB=RSUB+1

                   SET REMINDER(RSUB)=PXRMREM(SUB)

                   SET ^TMP("PXRMXS1",$JOB,RIEN)=""

               End DoDot:1

 +16      ;

 +17       KILL ^TMP("PXRMXS1",$JOB)

 +18       QUIT 

 +19      ;

MREM(CIEN,REM) ;Add to output array

 +1        NEW DATA,NAME,NREM,RIEN,PNAME,SEQ,SUB,TEMP

 +2       ;Add to end of list

 +3        SET NREM=+$ORDER(REM(""),-1)

 +4       ;

 +5       ;Sort Reminders from this category into display sequence

 +6        SET SUB=0

           KILL TEMP

 +7        FOR 

               SET SUB=$ORDER(^PXRMD(811.7,CIEN,2,SUB))

               if SUB=""

                   QUIT 

               Begin DoDot:1

 +8                SET DATA=$GET(^PXRMD(811.7,CIEN,2,SUB,0))

                   if DATA=""

                       QUIT 

 +9       ;Ignore duplicates

 +10               SET RIEN=$PIECE(DATA,U)

                   if RIEN=""

                       QUIT 

                   if $DATA(^TMP("PXRMXS1",$JOB,RIEN))

                       QUIT 

 +11               SET SEQ=$PIECE(DATA,U,2)_0

 +12               SET DATA=$GET(^PXD(811.9,RIEN,0))

 +13               SET NAME=$PIECE(DATA,U)

                   SET PNAME=$PIECE(DATA,U,3)

 +14               SET TEMP(SEQ)=RIEN_U_NAME_U_NAME_U_PNAME

 +15               SET ^TMP("PXRMXS1",$JOB,RIEN)=""

               End DoDot:1

 +16      ;

 +17      ;Re-save reminders in output array for display

 +18      ;unique number^type^name^parent^reminder ien

 +19      ;

 +20       SET SEQ=""

 +21       FOR 

               SET SEQ=$ORDER(TEMP(SEQ))

               if SEQ=""

                   QUIT 

               Begin DoDot:1

 +22               SET NREM=NREM+1

                   SET REM(NREM)=TEMP(SEQ)

               End DoDot:1

 +23      ;

 +24      ;Sort Sub-Categories for this category into display order

 +25       SET SUB=0

           KILL TEMP

 +26       FOR 

               SET SUB=$ORDER(^PXRMD(811.7,CIEN,10,SUB))

               if SUB=""

                   QUIT 

               Begin DoDot:1

 +27               SET DATA=$GET(^PXRMD(811.7,CIEN,10,SUB,0))

                   if DATA=""

                       QUIT 

 +28               SET SEQ=$PIECE(DATA,U,2)

                   SET TEMP(SEQ)=SUB

               End DoDot:1

 +29      ;

 +30      ;Process sub-sub categories in the same manner

 +31       SET SEQ=""

 +32       FOR 

               SET SEQ=$ORDER(TEMP(SEQ))

               if SEQ=""

                   QUIT 

               Begin DoDot:1

 +33               NEW IEN

 +34               SET SUB=TEMP(SEQ)

                   SET IEN=$PIECE($GET(^PXRMD(811.7,CIEN,10,SUB,0)),U)

                   if 'IEN

                       QUIT 

 +35               DO MREM(IEN,.REM)

               End DoDot:1

 +36       QUIT 

 +37      ;

 +38      ;Check if a category has any sub-categories

 +39      ;------------------------------------------

OK(CIEN)  ;

 +1       ;Check in reminder multiple

 +2        IF $$FOUND(CIEN)

               QUIT 1

 +3       ;

 +4       ;Otherwise check the sub-categories

 +5        NEW DATA,FOUND,IEN,SUB

 +6        SET FOUND=0

           SET SUB=0

 +7        FOR 

               SET SUB=$ORDER(^PXRMD(811.7,CIEN,10,SUB))

               if SUB=""

                   QUIT 

               Begin DoDot:1

 +8                SET DATA=$GET(^PXRMD(811.7,CIEN,10,SUB,0))

                   if DATA=""

                       QUIT 

 +9                SET IEN=$PIECE(DATA,U)

                   if 'IEN

                       QUIT 

 +10      ;Check for active reminders in reminder multiple

 +11               SET FOUND=$$FOUND(IEN)

               End DoDot:1

               if FOUND

                   QUIT 

 +12       QUIT FOUND