PXRMRLST.m

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

 ;

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      ;