Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMCLST

PXRMCLST.m

Go to the documentation of this file.
  1. PXRMCLST ;SLC/PJH - List Reminder Categories ;08/25/2011
  1. ;;2.0;CLINICAL REMINDERS;**18**;Feb 04, 2005;Build 152
  1. ;
  1. ;List all categories (for protocol PXRM SELECTION LIST)
  1. ;-------------------
  1. ALL N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO,Y
  1. S Y=1
  1. D SET
  1. S DIC="^PXRMD(811.7,"
  1. S BY=".01"
  1. S FR=""
  1. S TO=""
  1. S DHD="W ?0 D HED^PXRMCLST"
  1. D DISP
  1. Q
  1. ;
  1. ;DISPLAY (Display from FLDS array)
  1. ;-------
  1. DISP S L=0,FLDS="[PXRM REMINDER CATEGORIES]"
  1. D EN1^DIP
  1. Q
  1. ;
  1. ;Build list of sub-categories
  1. ;----------------------------
  1. DSP N ARRAY,IC,SEQ,TAB,TXT
  1. ;
  1. ; D0=IEN OF PARENT D1=NODE NUMBER IN 10 OF CHILD
  1. ;
  1. S IC=0 D GETLST(D0,D1,0)
  1. ;Display list of sub-categories
  1. S IC=0
  1. F S IC=$O(ARRAY(IC)) Q:IC="" D
  1. .S TAB=$P(ARRAY(IC),U),TXT=$P(ARRAY(IC),U,2)
  1. .W !,?TAB,TXT
  1. Q
  1. ;
  1. ;Get list of sub-categories
  1. ;--------------------------
  1. GETLST(D0,D1,LEVEL) ;
  1. N CHILD,DATA,NAME,PXRMIEN,PXRMCAT,SEQ,SUB,TEMP
  1. ;Determine if this subcategory has children
  1. S DATA=$G(^PXRMD(811.7,D0,10,D1,0)) Q:DATA=""
  1. S PXRMCAT=$P(DATA,U) Q:PXRMCAT=""
  1. S NAME=$G(^PXRMD(811.7,PXRMCAT,0)) I NAME="" S NAME=PXRMCAT
  1. S IC=IC+1,ARRAY(IC)=LEVEL_U_"Sub-category: "_NAME
  1. ;Increment tab
  1. S LEVEL=LEVEL+5
  1. ;Don't allow > 4 levels
  1. I LEVEL>20 S IC=IC+1,ARRAY(IC)=LEVEL_U_"Further levels" Q
  1. ;
  1. ;Sort Reminders from this category into display sequence
  1. S SUB=0 K TEMP
  1. F S SUB=$O(^PXRMD(811.7,PXRMCAT,2,SUB)) Q:SUB="" D
  1. .S DATA=$G(^PXRMD(811.7,PXRMCAT,2,SUB,0)) Q:DATA=""
  1. .S PXRMIEN=$P(DATA,U) Q:PXRMIEN=""
  1. .S SEQ=$P(DATA,U,2)
  1. .S DATA=$G(^PXD(811.9,PXRMIEN,0)) Q:DATA=""
  1. .S NAME=$P(DATA,U) I NAME="" S NAME="Unknown"
  1. .S TEMP(SEQ)=NAME
  1. ;
  1. ;Re-save reminders in output array for display
  1. S SEQ=""
  1. F S SEQ=$O(TEMP(SEQ)) Q:SEQ="" D
  1. .S IC=IC+1
  1. .S ARRAY(IC)=LEVEL_U_"Sequence: "_$J(SEQ,2)_" Reminder: "_TEMP(SEQ)
  1. ;
  1. ;Sort Sub-Categories for this category into display order
  1. S SUB=0 K TEMP
  1. F S SUB=$O(^PXRMD(811.7,PXRMCAT,10,SUB)) Q:SUB="" D
  1. .S DATA=$G(^PXRMD(811.7,PXRMCAT,10,SUB,0)) Q:DATA=""
  1. .S SEQ=$P(DATA,U,2),TEMP(SEQ)=SUB
  1. ;
  1. ;Process sub-sub categories in the same manner
  1. S SEQ=""
  1. F S SEQ=$O(TEMP(SEQ)) Q:SEQ="" D
  1. .S SUB=TEMP(SEQ)
  1. .D GETLST(PXRMCAT,SUB,LEVEL)
  1. Q
  1. ;
  1. ;Display Header (see DHD variable)
  1. ;--------------
  1. HED N TEMP,TEXTLEN,TEXTHED,TEXTUND
  1. S TEXTHED="REMINDER CATEGORY LIST"
  1. S TEXTUND=$TR($J("",IOM)," ","-")
  1. S TEMP=NOW_" Page "_DC
  1. S TEXTLEN=$L(TEMP)
  1. W TEXTHED
  1. W ?(IOM-TEXTLEN),TEMP
  1. W !,TEXTUND,!!
  1. Q
  1. ;
  1. ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)
  1. ;--------------------
  1. INQ(Y) N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO
  1. S DIC="^PXRMD(811.7,"
  1. S DIC(0)="AEMQ"
  1. D SET
  1. D DISP
  1. Q
  1. ;
  1. ;Input Transforms for edit option PXRM REMINDER CATEGORY EDIT #811.7
  1. ;-------------------------------------------------------------------
  1. BADITEM(X,DA1) ;Subcategory
  1. I X=DA1 Q 1
  1. Q '$$PARENTOK(DA1,X)
  1. ;
  1. KILLAC ;This only applies if deleting a sub-category
  1. I '$D(^PXRMD(811.7,DA)) Q
  1. ;
  1. N SUB,MAS
  1. S MAS=""
  1. ;Get the parent categories for this sub sub-category, quit if none
  1. F S MAS=$O(^PXRMD(811.7,"AC",DA,MAS)) Q:MAS="" D
  1. .;Get sub category position in the parent, quit if none
  1. .S SUB=$O(^PXRMD(811.7,"AC",DA,MAS,"")) Q:SUB=""
  1. .;
  1. .;Kill the sub category on the parent category
  1. .N DIC,DIK,DA S DIK="^PXRMD(811.7,MAS,10,",DA(1)=MAS,DA=SUB D ^DIK
  1. .;Cross reference on SUBCATEGORY field kills the AC index entry
  1. Q
  1. ;
  1. PARENTOK(PARENT,ITEM) ;Returns true if category is already in tree
  1. N IDX,OK
  1. S IDX=0,OK=1
  1. F S IDX=$O(^PXRMD(811.7,"AC",PARENT,IDX)) Q:'IDX D Q:'OK
  1. .I IDX=ITEM S OK=0 Q
  1. .S OK=$$PARENTOK(IDX,ITEM)
  1. Q OK
  1. ;
  1. ;Reminders for this category
  1. ;---------------------------
  1. REM N ARRAY,DATA,IC,NAME,PXRMIEN,SEQ,TEMP
  1. ;
  1. ; D0=IEN OF CATEGORY
  1. ;
  1. S SUB=0
  1. ;Sort Reminders from this category into display sequence
  1. F S SUB=$O(^PXRMD(811.7,D0,2,SUB)) Q:SUB="" D
  1. .S DATA=$G(^PXRMD(811.7,D0,2,SUB,0)) Q:DATA=""
  1. .S PXRMIEN=$P(DATA,U) Q:PXRMIEN=""
  1. .S SEQ=$P(DATA,U,2)
  1. .S DATA=$G(^PXD(811.9,PXRMIEN,0)) Q:DATA=""
  1. .S NAME=$P(DATA,U) I NAME="" S NAME="Unknown"
  1. .S TEMP(SEQ_0)=NAME
  1. ;
  1. I $O(TEMP(""))="" W ! Q
  1. ;
  1. ;Re-save reminders in output array for display
  1. S SEQ="",IC=0
  1. F S SEQ=$O(TEMP(SEQ)) Q:SEQ="" D
  1. .S IC=IC+1
  1. .S ARRAY(IC)="Sequence: "_$J(SEQ/10,2)_" Reminder: "_TEMP(SEQ)
  1. ;
  1. S IC=0
  1. F S IC=$O(ARRAY(IC)) Q:IC="" D
  1. .W !,ARRAY(IC)
  1. Q
  1. ;
  1. SETAC Q
  1. ;
  1. ;Verify Reminder/Category display order is unique
  1. ;RECORD 2=Reminder 10=Sub-category
  1. UNIQUE(X,DA1,DA,RECORD) ;
  1. N SUB,DATA,SEQ,TEMP
  1. S SUB=0
  1. F S SUB=$O(^PXRMD(811.7,DA1,RECORD,SUB)) Q:'SUB D
  1. .Q:SUB=DA
  1. .S SEQ=$P($G(^PXRMD(811.7,DA1,RECORD,SUB,0)),U,2)
  1. .I SEQ'="" S TEMP(SEQ)=""
  1. I $D(TEMP(X)) D EN^DDIOL("Sequence number "_X_" already used") Q 0
  1. Q 1
  1. ;
  1. SET ;Setup all the variables
  1. ; Set Date for Header
  1. S NOW=$$NOW^XLFDT
  1. S NOW=$$FMTE^XLFDT(NOW,"1P")
  1. ;
  1. ;These variables need to be setup every time because DIP kills them.
  1. S BY="NUMBER"
  1. S (FR,TO)=+$P(Y,U,1)
  1. S DHD="W ?0 D HED^PXRMCLST"
  1. ;
  1. Q