RMPFDS.m

RMPFDS ;DDC/KAW-LIST ORDERS BY PATIENT OR STATUS; [ 08/25/97  12:03 PM ]

 ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**8**;MAY 30, 1995

RMPFSET I '$D(RMPFMENU) D MENU^RMPFUTL I '$D(RMPFMENU) W !!,$C(7),"*** A MENU SELECTION MUST BE MADE ***" Q  ;;RMPFMENU must be defined

 I '$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS) D ^RMPFUTL Q:'$D(RMPFSTAN)!'$D(RMPFDAT)!'$D(RMPFSYS)

 W @IOF,!!,"LIST ORDERS BY PATIENT OR STATUS"

 S Y=DT D DD^%DT S RMPFDAT=Y

A1 W !!,"List Orders by <P>atient or by <S>tatus:  "

 D READ G END:$D(RMPFOUT)

A11 I $D(RMPFQUT) W !!,"Enter a <P> to display a list of orders for a patient or",!?5,"an <S> to display all orders with a chosen status." G A1

 G END:Y="" S Y=$E(Y,1) I "PpSs"'[Y S RMPFQUT="" G A11

 S RMPFORD=$S("Pp"[Y:"P",1:"S") G PAT:RMPFORD="P"

STAT W !!,"Enter an <*> to Display ALL Orders or",!,"Enter One or More of the Following Statuses Separated by Commas:",! S (CT,X)=0 K RMPFP

 F  S X=$O(^RMPF(791810.2,X)) Q:X=""  D

 .Q:'$D(^RMPF(791810.2,X,0))  S A=$P(^(0),U,1),B=$P(^(0),U,2),C=$P(^(0),U,10)

 .I RMPFMENU=10,C Q

 .I B'="" W !?5,"<",B,">  ",?11,A S CT=CT+1

S1 W !!,"Select Status(es): " D READ G END:$D(RMPFOUT)

S11 I $D(RMPFQUT) W !!,"Enter the letter of the status you wish to print or <*> to print all status." H 1 G STAT

 G A1:Y="" I Y="*" S RMPFP=Y G S2

 F I=1:1 S X=$P(Y,",",I) Q:X=""  D  G S11:$D(RMPFQUT)

 .I '$D(^RMPF(791810.2,"C",X)) S RMPFQUT="" Q

 .S Z=$O(^RMPF(791810.2,"C",X,0)) I Z S RMPFP(Z)=""

 .Q

 G A1:'$D(RMPFP)

S2 K RMPFOO W !!,"Print for <A>ll or <S>elected Ordering Officials: ALL// "

 D READ G END:$D(RMPFOUT)

S21 I $D(RMPFQUT) W !!,"Enter an <A> to print orders for ALL Ordering Officials",!?6,"an <S> to select an ordering official" G S2

 S:Y="" Y="A" S Y=$E(Y,1) I "AaSs"'[Y S RMPFQUT="" G S21

 G TYP:"Aa"[Y

S3 W ! S DIC="^VA(200,",DIC(0)="AEQM",DIC("A")="Select Ordering Official: "

 D ^DIC G S2:Y=-1 S RMPFOO=+Y K DIC G TYP

PAT W ! S DIC=2,DIC(0)="AEQM" D ^DIC G END:Y=-1 S DFN=+Y

 S RMPFTP="P" G DISP

TYP W !!,"Display <P>atient, <S>tation or <B>oth Types of Orders: B// "

 D READ G END:$D(RMPFOUT)

TYP1 I $D(RMPFQUT) W !!,"Enter a <P> to display only patient type orders,",!?5,"an <S> to display only station type orders,",!?8,"<B> or <RETURN> to display both types." G TYP

 S:Y="" Y="B" S Y=$E(Y,1) I "BbPpSs"'[Y S RMPFQUT="" G TYP1

 S RMPFTP=$S("Bb"[Y:"B","Pp"[Y:"P",1:"S")

DISP D ^RMPFDS1 G RMPFSET:$D(RMPFOUT)

 I IOST?1"P-".E W @IOF

 E  D CONT^RMPFDS1 G END:$D(RMPFOUT),RMPFSET

END K RMPFORD,RMPFTP,RMPFS,RMPFOUT,RMPFQUT,DIC,DFN,RMPFCX,RMPFP,RMPFO

 K RMPFOO,DIPGM,DISYS,CT,S0,%,%Y,%XX,%YY,A,B,C,I,J,Y,X,Z Q

READ K RMPFOUT,RMPFQUT

 R Y:DTIME I '$T W $C(7) R Y:5 G READ:Y="." S:'$T Y=U

 I Y?1"^".E S (RMPFOUT,Y)="" Q

 S:Y?1"?".E (RMPFQUT,Y)=""

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RMPFDS   2753     printed  Mar 13, 2025@21:40:52                                                                                                                                                                                                      Page 2

RMPFDS    ;DDC/KAW-LIST ORDERS BY PATIENT OR STATUS; [ 08/25/97  12:03 PM ]

 +1       ;;2.0;REMOTE ORDER/ENTRY SYSTEM;**8**;MAY 30, 1995

RMPFSET   ;;RMPFMENU must be defined

           IF '$DATA(RMPFMENU)

               DO MENU^RMPFUTL

               IF '$DATA(RMPFMENU)

                   WRITE !!,$CHAR(7),"*** A MENU SELECTION MUST BE MADE ***"

                   QUIT 

 +1        IF '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)

               DO ^RMPFUTL

               if '$DATA(RMPFSTAN)!'$DATA(RMPFDAT)!'$DATA(RMPFSYS)

                   QUIT 

 +2        WRITE @IOF,!!,"LIST ORDERS BY PATIENT OR STATUS"

 +3        SET Y=DT

           DO DD^%DT

           SET RMPFDAT=Y

A1         WRITE !!,"List Orders by <P>atient or by <S>tatus:  "

 +1        DO READ

           if $DATA(RMPFOUT)

               GOTO END

A11        IF $DATA(RMPFQUT)

               WRITE !!,"Enter a <P> to display a list of orders for a patient or",!?5,"an <S> to display all orders with a chosen status."

               GOTO A1

 +1        if Y=""

               GOTO END

           SET Y=$EXTRACT(Y,1)

           IF "PpSs"'[Y

               SET RMPFQUT=""

               GOTO A11

 +2        SET RMPFORD=$SELECT("Pp"[Y:"P",1:"S")

           if RMPFORD="P"

               GOTO PAT

STAT       WRITE !!,"Enter an <*> to Display ALL Orders or",!,"Enter One or More of the Following Statuses Separated by Commas:",!

           SET (CT,X)=0

           KILL RMPFP

 +1        FOR 

               SET X=$ORDER(^RMPF(791810.2,X))

               if X=""

                   QUIT 

               Begin DoDot:1

 +2                if '$DATA(^RMPF(791810.2,X,0))

                       QUIT 

                   SET A=$PIECE(^(0),U,1)

                   SET B=$PIECE(^(0),U,2)

                   SET C=$PIECE(^(0),U,10)

 +3                IF RMPFMENU=10

                       IF C

                           QUIT 

 +4                IF B'=""

                       WRITE !?5,"<",B,">  ",?11,A

                       SET CT=CT+1

               End DoDot:1

S1         WRITE !!,"Select Status(es): "

           DO READ

           if $DATA(RMPFOUT)

               GOTO END

S11        IF $DATA(RMPFQUT)

               WRITE !!,"Enter the letter of the status you wish to print or <*> to print all status."

               HANG 1

               GOTO STAT

 +1        if Y=""

               GOTO A1

           IF Y="*"

               SET RMPFP=Y

               GOTO S2

 +2        FOR I=1:1

               SET X=$PIECE(Y,",",I)

               if X=""

                   QUIT 

               Begin DoDot:1

 +3                IF '$DATA(^RMPF(791810.2,"C",X))

                       SET RMPFQUT=""

                       QUIT 

 +4                SET Z=$ORDER(^RMPF(791810.2,"C",X,0))

                   IF Z

                       SET RMPFP(Z)=""

 +5                QUIT 

               End DoDot:1

               if $DATA(RMPFQUT)

                   GOTO S11

 +6        if '$DATA(RMPFP)

               GOTO A1

S2         KILL RMPFOO

           WRITE !!,"Print for <A>ll or <S>elected Ordering Officials: ALL// "

 +1        DO READ

           if $DATA(RMPFOUT)

               GOTO END

S21        IF $DATA(RMPFQUT)

               WRITE !!,"Enter an <A> to print orders for ALL Ordering Officials",!?6,"an <S> to select an ordering official"

               GOTO S2

 +1        if Y=""

               SET Y="A"

           SET Y=$EXTRACT(Y,1)

           IF "AaSs"'[Y

               SET RMPFQUT=""

               GOTO S21

 +2        if "Aa"[Y

               GOTO TYP

S3         WRITE !

           SET DIC="^VA(200,"

           SET DIC(0)="AEQM"

           SET DIC("A")="Select Ordering Official: "

 +1        DO ^DIC

           if Y=-1

               GOTO S2

           SET RMPFOO=+Y

           KILL DIC

           GOTO TYP

PAT        WRITE !

           SET DIC=2

           SET DIC(0)="AEQM"

           DO ^DIC

           if Y=-1

               GOTO END

           SET DFN=+Y

 +1        SET RMPFTP="P"

           GOTO DISP

TYP        WRITE !!,"Display <P>atient, <S>tation or <B>oth Types of Orders: B// "

 +1        DO READ

           if $DATA(RMPFOUT)

               GOTO END

TYP1       IF $DATA(RMPFQUT)

               WRITE !!,"Enter a <P> to display only patient type orders,",!?5,"an <S> to display only station type orders,",!?8,"<B> or <RETURN> to display both types."

               GOTO TYP

 +1        if Y=""

               SET Y="B"

           SET Y=$EXTRACT(Y,1)

           IF "BbPpSs"'[Y

               SET RMPFQUT=""

               GOTO TYP1

 +2        SET RMPFTP=$SELECT("Bb"[Y:"B","Pp"[Y:"P",1:"S")

DISP       DO ^RMPFDS1

           if $DATA(RMPFOUT)

               GOTO RMPFSET

 +1        IF IOST?1"P-".E

               WRITE @IOF

 +2       IF '$TEST

               DO CONT^RMPFDS1

               if $DATA(RMPFOUT)

                   GOTO END

               GOTO RMPFSET

END        KILL RMPFORD,RMPFTP,RMPFS,RMPFOUT,RMPFQUT,DIC,DFN,RMPFCX,RMPFP,RMPFO

 +1        KILL RMPFOO,DIPGM,DISYS,CT,S0,%,%Y,%XX,%YY,A,B,C,I,J,Y,X,Z

           QUIT 

READ       KILL RMPFOUT,RMPFQUT

 +1        READ Y:DTIME

           IF '$TEST

               WRITE $CHAR(7)

               READ Y:5

               if Y="."

                   GOTO READ

               if '$TEST

                   SET Y=U

 +2        IF Y?1"^".E

               SET (RMPFOUT,Y)=""

               QUIT 

 +3        if Y?1"?".E

               SET (RMPFQUT,Y)=""

 +4        QUIT