PXRMCAT ; SLC/PJH - Edit/Inquire reminder categories ;01/05/2001
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
;
;Called by option PXRM REMINDER CATEGORIES
;
START N DIC,PXRMHD,PXRMCAT,PXRMGTYP,Y
SELECT ;General selection
S PXRMHD="Reminder Categories",PXRMGTYP="RCAT",PXRMCAT=""
D START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMCAT")
;Should return a value
I PXRMCAT D G SELECT
.S PXRMHD="REMINDER CATEGORY NAME:"
.;Listman option
.D START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMCAT)
END Q
;
;Build Category Inquiry array
;----------------------------
BUILD(ARRAY,D0) ;
N D1,IC,LEVEL,SEQ,TAB,TXT,TEMP
;Category Description
S LEVEL=5 D DES
;Reminders
S LEVEL=0 D REM
;Sort Sub-category into display order
D SORT(D0,.TEMP)
;Sub-category ... D0=IEN OF PARENT D1=NODE NUMBER IN 10 OF CHILD
S SEQ=0
F S SEQ=$O(TEMP(SEQ)) Q:'SEQ D
.S D1=TEMP(SEQ)
.D GETLST(D0,D1,0)
Q
;
;Build display for selected category - Called from PXRMGEN
;---------------------------------------------------------
CAT(PXRMCAT) ;
N DATA,DARRAY,SUB
S VALMCNT=0 K ^TMP("PXRMGENS",$J),^TMP("PXRMGEN",$J)
;
;Format headings to include category name
S HEADER=PXRMHD_" "_$P(^PXRMD(811.7,PXRMCAT,0),U)
;
;Build Reminder Category Display
D BUILD(.DARRAY,PXRMCAT) M ^TMP("PXRMGENS",$J)=DARRAY
;
;Put the list into the array List Manager is using.
S SUB="",VALMCNT=0
F S SUB=$O(^TMP("PXRMGENS",$J,SUB)) Q:SUB="" D
.S DATA=$G(^TMP("PXRMGENS",$J,SUB))
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMGEN",$J,VALMCNT,0)=DATA
K ^TMP("PXRMGENS",$J)
;Create headings
D CHGCAP^VALM("HEADER1","")
D CHGCAP^VALM("HEADER2","")
D CHGCAP^VALM("HEADER3","")
Q
;
;Category description
;--------------------
DES ;array.
N DIWF,DIWL,DIWR,SUB,X
S DIWF="C70",DIWL=0,DIWR=70
K ^UTILITY($J,"W")
S SUB=0
F S SUB=$O(^PXRMD(811.7,D0,1,SUB)) Q:SUB="" D
.S X=$G(^PXRMD(811.7,D0,1,SUB,0))
.D ^DIWP
S ARRAY(1)="Category Description:",IC=1
F S SUB=$O(^UTILITY($J,"W",0,SUB)) Q:SUB="" D
.S IC=IC+1,ARRAY(IC)=$J("",LEVEL)_^UTILITY($J,"W",0,SUB,0)
K ^UTILITY($J,"W")
Q
;
;Get list of sub-categories
;--------------------------
GETLST(D0,D1,LEVEL) ;
N CHILD,DATA,NAME,PXRMIEN,PXRMCAT,PXRMSEQ,SEQ,SUB,TEMP
;Determine if this subcategory has children
S DATA=$G(^PXRMD(811.7,D0,10,D1,0)) Q:DATA=""
S PXRMCAT=$P(DATA,U) Q:PXRMCAT=""
S PXRMSEQ=$P(DATA,U,2),NAME=$G(^PXRMD(811.7,PXRMCAT,0))
I NAME="" S NAME=PXRMCAT
I LEVEL=0 S IC=IC+1,ARRAY(IC)=""
S IC=IC+1,ARRAY(IC)=$J("",LEVEL)_"Sub-category:"_NAME
S ARRAY(IC)=ARRAY(IC)_$J("",38-$L(NAME))_" Sequence: "_PXRMSEQ
;Increment tab
S LEVEL=LEVEL+5
;Don't allow > 4 levels
I LEVEL>20 S IC=IC+1,ARRAY(IC)=$J("",LEVEL)_"Further levels" Q
;Save details of reminders for this category
D REM
;Sort Sub-categories into display order
D SORT(PXRMCAT,.TEMP)
;
;Process sub-sub categories in the same manner
S SEQ=""
F S SEQ=$O(TEMP(SEQ)) Q:SEQ="" D
.S SUB=TEMP(SEQ)
.D GETLST(PXRMCAT,SUB,LEVEL)
Q
;
;Reminders for this category
;---------------------------
REM S SUB=0 K TEMP
;Sort Reminders from this category into display sequence
F S SUB=$O(^PXRMD(811.7,PXRMCAT,2,SUB)) Q:SUB="" D
.S DATA=$G(^PXRMD(811.7,PXRMCAT,2,SUB,0)) Q:DATA=""
.S PXRMIEN=$P(DATA,U) Q:PXRMIEN=""
.S SEQ=$P(DATA,U,2)
.S DATA=$G(^PXD(811.9,PXRMIEN,0)) Q:DATA=""
.S NAME=$P(DATA,U) I NAME="" S NAME="Unknown"
.S TEMP(SEQ_0)=NAME
;
I LEVEL=0,$O(TEMP("")) S IC=IC+1,ARRAY(IC)=""
;
;Re-save reminders in output array for display
S SEQ=""
F S SEQ=$O(TEMP(SEQ)) Q:SEQ="" D
.S IC=IC+1
.S ARRAY(IC)=$J("",LEVEL)_"Sequence: "_$J(SEQ/10,2)_" Reminder: "_TEMP(SEQ)
Q
;
;Sort Sub-Categories for this category into display order
;--------------------------------------------------------
SORT(PXRMCAT,TEMP) ;
N DATA,SEQ,SUB
S SUB=0 K TEMP
F S SUB=$O(^PXRMD(811.7,PXRMCAT,10,SUB)) Q:SUB="" D
.S DATA=$G(^PXRMD(811.7,PXRMCAT,10,SUB,0)) Q:DATA=""
.S SEQ=$P(DATA,U,2),TEMP(SEQ)=SUB
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMCAT 4029 printed Apr 09, 2024@20:49:58 Page 2
PXRMCAT ; SLC/PJH - Edit/Inquire reminder categories ;01/05/2001
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 ;
+3 ;Called by option PXRM REMINDER CATEGORIES
+4 ;
START NEW DIC,PXRMHD,PXRMCAT,PXRMGTYP,Y
SELECT ;General selection
+1 SET PXRMHD="Reminder Categories"
SET PXRMGTYP="RCAT"
SET PXRMCAT=""
+2 DO START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMCAT")
+3 ;Should return a value
+4 IF PXRMCAT
Begin DoDot:1
+5 SET PXRMHD="REMINDER CATEGORY NAME:"
+6 ;Listman option
+7 DO START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMCAT)
End DoDot:1
GOTO SELECT
END QUIT
+1 ;
+2 ;Build Category Inquiry array
+3 ;----------------------------
BUILD(ARRAY,D0) ;
+1 NEW D1,IC,LEVEL,SEQ,TAB,TXT,TEMP
+2 ;Category Description
+3 SET LEVEL=5
DO DES
+4 ;Reminders
+5 SET LEVEL=0
DO REM
+6 ;Sort Sub-category into display order
+7 DO SORT(D0,.TEMP)
+8 ;Sub-category ... D0=IEN OF PARENT D1=NODE NUMBER IN 10 OF CHILD
+9 SET SEQ=0
+10 FOR
SET SEQ=$ORDER(TEMP(SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+11 SET D1=TEMP(SEQ)
+12 DO GETLST(D0,D1,0)
End DoDot:1
+13 QUIT
+14 ;
+15 ;Build display for selected category - Called from PXRMGEN
+16 ;---------------------------------------------------------
CAT(PXRMCAT) ;
+1 NEW DATA,DARRAY,SUB
+2 SET VALMCNT=0
KILL ^TMP("PXRMGENS",$JOB),^TMP("PXRMGEN",$JOB)
+3 ;
+4 ;Format headings to include category name
+5 SET HEADER=PXRMHD_" "_$PIECE(^PXRMD(811.7,PXRMCAT,0),U)
+6 ;
+7 ;Build Reminder Category Display
+8 DO BUILD(.DARRAY,PXRMCAT)
MERGE ^TMP("PXRMGENS",$JOB)=DARRAY
+9 ;
+10 ;Put the list into the array List Manager is using.
+11 SET SUB=""
SET VALMCNT=0
+12 FOR
SET SUB=$ORDER(^TMP("PXRMGENS",$JOB,SUB))
if SUB=""
QUIT
Begin DoDot:1
+13 SET DATA=$GET(^TMP("PXRMGENS",$JOB,SUB))
+14 SET VALMCNT=VALMCNT+1
+15 SET ^TMP("PXRMGEN",$JOB,VALMCNT,0)=DATA
End DoDot:1
+16 KILL ^TMP("PXRMGENS",$JOB)
+17 ;Create headings
+18 DO CHGCAP^VALM("HEADER1","")
+19 DO CHGCAP^VALM("HEADER2","")
+20 DO CHGCAP^VALM("HEADER3","")
+21 QUIT
+22 ;
+23 ;Category description
+24 ;--------------------
DES ;array.
+1 NEW DIWF,DIWL,DIWR,SUB,X
+2 SET DIWF="C70"
SET DIWL=0
SET DIWR=70
+3 KILL ^UTILITY($JOB,"W")
+4 SET SUB=0
+5 FOR
SET SUB=$ORDER(^PXRMD(811.7,D0,1,SUB))
if SUB=""
QUIT
Begin DoDot:1
+6 SET X=$GET(^PXRMD(811.7,D0,1,SUB,0))
+7 DO ^DIWP
End DoDot:1
+8 SET ARRAY(1)="Category Description:"
SET IC=1
+9 FOR
SET SUB=$ORDER(^UTILITY($JOB,"W",0,SUB))
if SUB=""
QUIT
Begin DoDot:1
+10 SET IC=IC+1
SET ARRAY(IC)=$JUSTIFY("",LEVEL)_^UTILITY($JOB,"W",0,SUB,0)
End DoDot:1
+11 KILL ^UTILITY($JOB,"W")
+12 QUIT
+13 ;
+14 ;Get list of sub-categories
+15 ;--------------------------
GETLST(D0,D1,LEVEL) ;
+1 NEW CHILD,DATA,NAME,PXRMIEN,PXRMCAT,PXRMSEQ,SEQ,SUB,TEMP
+2 ;Determine if this subcategory has children
+3 SET DATA=$GET(^PXRMD(811.7,D0,10,D1,0))
if DATA=""
QUIT
+4 SET PXRMCAT=$PIECE(DATA,U)
if PXRMCAT=""
QUIT
+5 SET PXRMSEQ=$PIECE(DATA,U,2)
SET NAME=$GET(^PXRMD(811.7,PXRMCAT,0))
+6 IF NAME=""
SET NAME=PXRMCAT
+7 IF LEVEL=0
SET IC=IC+1
SET ARRAY(IC)=""
+8 SET IC=IC+1
SET ARRAY(IC)=$JUSTIFY("",LEVEL)_"Sub-category:"_NAME
+9 SET ARRAY(IC)=ARRAY(IC)_$JUSTIFY("",38-$LENGTH(NAME))_" Sequence: "_PXRMSEQ
+10 ;Increment tab
+11 SET LEVEL=LEVEL+5
+12 ;Don't allow > 4 levels
+13 IF LEVEL>20
SET IC=IC+1
SET ARRAY(IC)=$JUSTIFY("",LEVEL)_"Further levels"
QUIT
+14 ;Save details of reminders for this category
+15 DO REM
+16 ;Sort Sub-categories into display order
+17 DO SORT(PXRMCAT,.TEMP)
+18 ;
+19 ;Process sub-sub categories in the same manner
+20 SET SEQ=""
+21 FOR
SET SEQ=$ORDER(TEMP(SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+22 SET SUB=TEMP(SEQ)
+23 DO GETLST(PXRMCAT,SUB,LEVEL)
End DoDot:1
+24 QUIT
+25 ;
+26 ;Reminders for this category
+27 ;---------------------------
REM SET SUB=0
KILL TEMP
+1 ;Sort Reminders from this category into display sequence
+2 FOR
SET SUB=$ORDER(^PXRMD(811.7,PXRMCAT,2,SUB))
if SUB=""
QUIT
Begin DoDot:1
+3 SET DATA=$GET(^PXRMD(811.7,PXRMCAT,2,SUB,0))
if DATA=""
QUIT
+4 SET PXRMIEN=$PIECE(DATA,U)
if PXRMIEN=""
QUIT
+5 SET SEQ=$PIECE(DATA,U,2)
+6 SET DATA=$GET(^PXD(811.9,PXRMIEN,0))
if DATA=""
QUIT
+7 SET NAME=$PIECE(DATA,U)
IF NAME=""
SET NAME="Unknown"
+8 SET TEMP(SEQ_0)=NAME
End DoDot:1
+9 ;
+10 IF LEVEL=0
IF $ORDER(TEMP(""))
SET IC=IC+1
SET ARRAY(IC)=""
+11 ;
+12 ;Re-save reminders in output array for display
+13 SET SEQ=""
+14 FOR
SET SEQ=$ORDER(TEMP(SEQ))
if SEQ=""
QUIT
Begin DoDot:1
+15 SET IC=IC+1
+16 SET ARRAY(IC)=$JUSTIFY("",LEVEL)_"Sequence: "_$JUSTIFY(SEQ/10,2)_" Reminder: "_TEMP(SEQ)
End DoDot:1
+17 QUIT
+18 ;
+19 ;Sort Sub-Categories for this category into display order
+20 ;--------------------------------------------------------
SORT(PXRMCAT,TEMP) ;
+1 NEW DATA,SEQ,SUB
+2 SET SUB=0
KILL TEMP
+3 FOR
SET SUB=$ORDER(^PXRMD(811.7,PXRMCAT,10,SUB))
if SUB=""
QUIT
Begin DoDot:1
+4 SET DATA=$GET(^PXRMD(811.7,PXRMCAT,10,SUB,0))
if DATA=""
QUIT
+5 SET SEQ=$PIECE(DATA,U,2)
SET TEMP(SEQ)=SUB
End DoDot:1
+6 QUIT
