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 ---[H[J[2J[HPXRMXS1 2821 printed Apr 09, 2024@20:50:31 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
