PXRMRLST ; SLC/PKR - Clinical Reminder definition list. ;01/03/2005
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
;
;==================================================
;Build the criteria for which reminders to list.
LIST N ALL,CRITERIA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IND
N LOCAL,LPREFIX,NCRIT,PREFIX,SORT,STATUS,X,Y
START S (ALL,LOCAL,NCRIT)=0
S (PREFIX,STATUS)=""
;
ALLQ S DIR(0)="YAO"
S DIR("A")="List all reminders? "
S DIR("B")="Y"
W !
D ^DIR
I $D(DIROUT)!$D(DIRUT) Q
I $D(DTOUT)!$D(DUOUT) Q
S ALL=Y
S NCRIT=NCRIT+1
S CRITERIA(NCRIT)=DIR("A")_" "_Y(0)
I ALL G ACTIVEQ
;
LOCALQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="YAO"
S DIR("A")="List all local reminders? "
S DIR("B")="Y"
W !
D ^DIR
I $D(DTOUT) Q
I $D(DUOUT)!$D(DIROUT) G ALLQ
S LOCAL=Y
S NCRIT=NCRIT+1
S CRITERIA(NCRIT)=DIR("A")_" "_Y(0)
I LOCAL G ACTIVEQ
;
PREFIXQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
S PREFIX=""
S DIR(0)="FAO"_U_"1:30"
S DIR("A")="List only reminders starting with (prefix)? "
S DIR("B")="VA-"
W !
D ^DIR
I $D(DTOUT) Q
I $D(DUOUT)!$D(DIROUT) G LOCALQ
S PREFIX=Y
S LPREFIX=$L(Y)
S NCRIT=NCRIT+1
S CRITERIA(NCRIT)=DIR("A")_" "_PREFIX
;
ACTIVEQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="SAO"_U_"A:Active;I:Inactive;B:Both"
S DIR("A")="List Active (A), Inactive (I), Both (B)? "
S DIR("B")="B"
W !
D ^DIR
I $D(DTOUT) Q
I $D(DUOUT)!$D(DIROUT) G START
S STATUS=Y
S NCRIT=NCRIT+1
S CRITERIA(NCRIT)=DIR("A")_" "_Y(0)
;
SORTQ K DIR,DIROUT,DIRUT,DTOUT,DUOUT
S SORT="N"
S DIR(0)="SAO"_U_"N:Name (.01);P:Print name"
S DIR("A")="Sort list by Name (N), Print Name (P)? "
S DIR("B")="N"
W !
D ^DIR
I $D(DTOUT) Q
I $D(DUOUT)!$D(DIROUT) G ACTIVEQ
S SORT=Y_U_Y(0)
S NCRIT=NCRIT+1
S CRITERIA(NCRIT)=DIR("A")_" "_Y(0)
;
;Make sure the criteria are ok.
W !!,"A reminder list will be created using the following criteria:"
F IND=1:1:NCRIT D
. W !,?2,CRITERIA(IND)
;
K CRITERIA
K DIR,DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="YAO"
S DIR("A")="Is this correct? "
S DIR("B")="Y"
W !
D ^DIR
I $D(DTOUT) Q
I $D(DUOUT)!$D(DIROUT) G START
I 'Y G START
;
;Build the list of reminders based on the input critera.
N IEN,NAME,NODE0,SFUN
;Setup the screening function to use
I ALL S SFUN="$$ALLS(NODE0,STATUS)"
I LOCAL S SFUN="$$LOCALS(NODE0,STATUS)"
I $L(PREFIX)>0 S SFUN="$$PREFIXS(NODE0,STATUS,PREFIX,LPREFIX)"
K ^TMP($J,"DEFLIST")
S IEN=0
F S IEN=$O(^PXD(811.9,IEN)) Q:+IEN=0 D
. S NODE0=^PXD(811.9,IEN,0)
. I @SFUN S ^TMP($J,"DEFLIST",IEN)=""
;Print the list
N BY,DIC,FLDS,FR,L,PXRMFVPL,PXRMROOT,TO
D BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
S (DIC,PXRMROOT)="^PXD(811.9,"
S FLDS="[PXRM DEFINITION LIST]"
S L=0
S L(0)=1
I $P(SORT,U,1)="N" S BY=.01
I $P(SORT,U,1)="P" S BY=1.2
S BY(0)="^TMP($J,""DEFLIST"""
S (FR,TO)=""
D EN1^DIP
K ^TMP($J,"DEFLIST")
Q
;
;==================================================
ALLS(NODE0,STATUS) ;Screen based on all reminders and status.
I STATUS="B" Q 1
N INFLAG
S INFLAG=$P(NODE0,U,6)
I (STATUS="A")&('INFLAG) Q 1
I (STATUS="I")&(INFLAG) Q 1
Q 0
;
;==================================================
LOCALS(NODE0,STATUS) ;Screen based on all local reminders and status.
N NAME
S NAME=$P(NODE0,U,1)
I NAME["VA-" Q 0
I STATUS="B" Q 1
N INFLAG
S INFLAG=$P(NODE0,U,6)
I (STATUS="A")&('INFLAG) Q 1
I (STATUS="I")&(INFLAG) Q 1
Q 0
;
;==================================================
PREFIXS(NODE0,STATUS,PREFIX,LPREFIX) ;Screen based on .01 prefix and status.
N NAME,PRE
S NAME=$P(NODE0,U,1)
S PRE=$E(NAME,1,LPREFIX)
I PRE'=PREFIX Q 0
I STATUS="B" Q 1
N INFLAG
S INFLAG=$P(NODE0,U,6)
I (STATUS="A")&('INFLAG) Q 1
I (STATUS="I")&(INFLAG) Q 1
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMRLST 3800 printed Nov 22, 2024@16:59:03 Page 2
PXRMRLST ; SLC/PKR - Clinical Reminder definition list. ;01/03/2005
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 ;
+3 ;==================================================
+4 ;Build the criteria for which reminders to list.
LIST NEW ALL,CRITERIA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IND
+1 NEW LOCAL,LPREFIX,NCRIT,PREFIX,SORT,STATUS,X,Y
START SET (ALL,LOCAL,NCRIT)=0
+1 SET (PREFIX,STATUS)=""
+2 ;
ALLQ SET DIR(0)="YAO"
+1 SET DIR("A")="List all reminders? "
+2 SET DIR("B")="Y"
+3 WRITE !
+4 DO ^DIR
+5 IF $DATA(DIROUT)!$DATA(DIRUT)
QUIT
+6 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+7 SET ALL=Y
+8 SET NCRIT=NCRIT+1
+9 SET CRITERIA(NCRIT)=DIR("A")_" "_Y(0)
+10 IF ALL
GOTO ACTIVEQ
+11 ;
LOCALQ KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+1 SET DIR(0)="YAO"
+2 SET DIR("A")="List all local reminders? "
+3 SET DIR("B")="Y"
+4 WRITE !
+5 DO ^DIR
+6 IF $DATA(DTOUT)
QUIT
+7 IF $DATA(DUOUT)!$DATA(DIROUT)
GOTO ALLQ
+8 SET LOCAL=Y
+9 SET NCRIT=NCRIT+1
+10 SET CRITERIA(NCRIT)=DIR("A")_" "_Y(0)
+11 IF LOCAL
GOTO ACTIVEQ
+12 ;
PREFIXQ KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+1 SET PREFIX=""
+2 SET DIR(0)="FAO"_U_"1:30"
+3 SET DIR("A")="List only reminders starting with (prefix)? "
+4 SET DIR("B")="VA-"
+5 WRITE !
+6 DO ^DIR
+7 IF $DATA(DTOUT)
QUIT
+8 IF $DATA(DUOUT)!$DATA(DIROUT)
GOTO LOCALQ
+9 SET PREFIX=Y
+10 SET LPREFIX=$LENGTH(Y)
+11 SET NCRIT=NCRIT+1
+12 SET CRITERIA(NCRIT)=DIR("A")_" "_PREFIX
+13 ;
ACTIVEQ KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+1 SET DIR(0)="SAO"_U_"A:Active;I:Inactive;B:Both"
+2 SET DIR("A")="List Active (A), Inactive (I), Both (B)? "
+3 SET DIR("B")="B"
+4 WRITE !
+5 DO ^DIR
+6 IF $DATA(DTOUT)
QUIT
+7 IF $DATA(DUOUT)!$DATA(DIROUT)
GOTO START
+8 SET STATUS=Y
+9 SET NCRIT=NCRIT+1
+10 SET CRITERIA(NCRIT)=DIR("A")_" "_Y(0)
+11 ;
SORTQ KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+1 SET SORT="N"
+2 SET DIR(0)="SAO"_U_"N:Name (.01);P:Print name"
+3 SET DIR("A")="Sort list by Name (N), Print Name (P)? "
+4 SET DIR("B")="N"
+5 WRITE !
+6 DO ^DIR
+7 IF $DATA(DTOUT)
QUIT
+8 IF $DATA(DUOUT)!$DATA(DIROUT)
GOTO ACTIVEQ
+9 SET SORT=Y_U_Y(0)
+10 SET NCRIT=NCRIT+1
+11 SET CRITERIA(NCRIT)=DIR("A")_" "_Y(0)
+12 ;
+13 ;Make sure the criteria are ok.
+14 WRITE !!,"A reminder list will be created using the following criteria:"
+15 FOR IND=1:1:NCRIT
Begin DoDot:1
+16 WRITE !,?2,CRITERIA(IND)
End DoDot:1
+17 ;
+18 KILL CRITERIA
+19 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT
+20 SET DIR(0)="YAO"
+21 SET DIR("A")="Is this correct? "
+22 SET DIR("B")="Y"
+23 WRITE !
+24 DO ^DIR
+25 IF $DATA(DTOUT)
QUIT
+26 IF $DATA(DUOUT)!$DATA(DIROUT)
GOTO START
+27 IF 'Y
GOTO START
+28 ;
+29 ;Build the list of reminders based on the input critera.
+30 NEW IEN,NAME,NODE0,SFUN
+31 ;Setup the screening function to use
+32 IF ALL
SET SFUN="$$ALLS(NODE0,STATUS)"
+33 IF LOCAL
SET SFUN="$$LOCALS(NODE0,STATUS)"
+34 IF $LENGTH(PREFIX)>0
SET SFUN="$$PREFIXS(NODE0,STATUS,PREFIX,LPREFIX)"
+35 KILL ^TMP($JOB,"DEFLIST")
+36 SET IEN=0
+37 FOR
SET IEN=$ORDER(^PXD(811.9,IEN))
if +IEN=0
QUIT
Begin DoDot:1
+38 SET NODE0=^PXD(811.9,IEN,0)
+39 IF @SFUN
SET ^TMP($JOB,"DEFLIST",IEN)=""
End DoDot:1
+40 ;Print the list
+41 NEW BY,DIC,FLDS,FR,L,PXRMFVPL,PXRMROOT,TO
+42 DO BLDRLIST^PXRMVPTR(811.902,.01,.PXRMFVPL)
+43 SET (DIC,PXRMROOT)="^PXD(811.9,"
+44 SET FLDS="[PXRM DEFINITION LIST]"
+45 SET L=0
+46 SET L(0)=1
+47 IF $PIECE(SORT,U,1)="N"
SET BY=.01
+48 IF $PIECE(SORT,U,1)="P"
SET BY=1.2
+49 SET BY(0)="^TMP($J,""DEFLIST"""
+50 SET (FR,TO)=""
+51 DO EN1^DIP
+52 KILL ^TMP($JOB,"DEFLIST")
+53 QUIT
+54 ;
+55 ;==================================================
ALLS(NODE0,STATUS) ;Screen based on all reminders and status.
+1 IF STATUS="B"
QUIT 1
+2 NEW INFLAG
+3 SET INFLAG=$PIECE(NODE0,U,6)
+4 IF (STATUS="A")&('INFLAG)
QUIT 1
+5 IF (STATUS="I")&(INFLAG)
QUIT 1
+6 QUIT 0
+7 ;
+8 ;==================================================
LOCALS(NODE0,STATUS) ;Screen based on all local reminders and status.
+1 NEW NAME
+2 SET NAME=$PIECE(NODE0,U,1)
+3 IF NAME["VA-"
QUIT 0
+4 IF STATUS="B"
QUIT 1
+5 NEW INFLAG
+6 SET INFLAG=$PIECE(NODE0,U,6)
+7 IF (STATUS="A")&('INFLAG)
QUIT 1
+8 IF (STATUS="I")&(INFLAG)
QUIT 1
+9 QUIT 0
+10 ;
+11 ;==================================================
PREFIXS(NODE0,STATUS,PREFIX,LPREFIX) ;Screen based on .01 prefix and status.
+1 NEW NAME,PRE
+2 SET NAME=$PIECE(NODE0,U,1)
+3 SET PRE=$EXTRACT(NAME,1,LPREFIX)
+4 IF PRE'=PREFIX
QUIT 0
+5 IF STATUS="B"
QUIT 1
+6 NEW INFLAG
+7 SET INFLAG=$PIECE(NODE0,U,6)
+8 IF (STATUS="A")&('INFLAG)
QUIT 1
+9 IF (STATUS="I")&(INFLAG)
QUIT 1
+10 QUIT 0
+11 ;
