ORLP00.m

ORLP00 ; slc/dcm,cla - Modify Patient Lists ;8/13/91  15:06

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997

DEL ;Delete items from patient list

 I '$D(^XUTL("OR",$J,"ORLP")) W !,"You must build a Patient List before using this option" Q

L1 S:'$D(OROPREF) OROPREF=$$GET^XPAR("USR.`"_DUZ,"ORLP DEFAULT LIST ORDER",1,"I") S ORUS="^XUTL(""OR"",$J,""ORLP"",",ORUS(0)="40MN",ORUS("T")="W @IOF,?37,""PATIENT LIST"",! ;F I=1:1:IOM-1 W ""-"""

 S ORUS("W")="S X=$S(OROPREF=""R"":$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),""^"",5),1:"""")_"" ""_$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),""^"")_"" (""_$E($P(^(0),""^"",2),6,9)_"")""",ORUS("A")="Select Patient(s) to Remove: "

 S ORUS("F")="^XUTL(""OR"",$J,""ORLP"","""_$S($L($P(^XUTL("OR",$J,"ORLP",0),"^",3)):$P(^(0),"^",3),1:"B")_""","

 S ORUS("H")="W !,""Enter a name, number or range separated by commas or a dash"""

 D EN^ORUS

 I ($D(Y)<10) D END Q

 S I=0 W !

 F  S I=$O(Y(I)) Q:I<1  I $D(^XUTL("OR",$J,"ORLP",+Y(I),0)) S X=^(0) D

 . K ^XUTL("OR",$J,"ORLP",+Y(I)),^XUTL("OR",$J,"ORLP","B",$P(X,"^"),+Y(I)),^XUTL("OR",$J,"ORLP","C",$P(X,"^",2),+Y(I)) W !,"..."_$P(Y(I),"^",2)_" removed"

 K ^XUTL("OR",$J,"ORV"),^("ORU"),^("ORW") S (C,I)=0 F  S I=$O(^XUTL("OR",$J,"ORLP",I)) Q:I<1  S C=C+1

 S $P(^XUTL("OR",$J,"ORLP",0),"^",4)=C

 D STOR^ORLP1

 S %=1 W !!,"Show modified working list" D YN^DICN Q:%=-1  I %=1 G L1

 D END

 Q

END K ORUS,OROPREF,Y

 Q

 ;

ASKPT(TEAM) ;from ^ORLPL or internally - ask for patients

 N Y,ORDIR

 F  D  Q:$D(DTOUT)!($D(DUOUT))!(ORDIR']"")

 . K DIR S DIR(0)="SO^N:NAME;W:WARD;C:CLINIC;P:PROVIDER;T:TREATING SPECIALTY"

 . S DIR("A")="    to enter additional patients. (? for help)"

 . S DIR("?",3)="a PROVIDER, or patients in a TREATING SPECIALTY."

 . S DIR("?",1)="You may add patients to this list individually by patient NAME, or as a"

 . S DIR("?",2)="group such as an entire WARD, patients in a CLINIC, all patients seeing"

 . S DIR("?",4)=""

 . S DIR("?",5)="                               ** CAUTION **"

 . S DIR("?")="The patients added here will create a static list that will not change through MAS movements."

 . D ^DIR S ORDIR=Y K DIR Q:Y=""!(Y["^")

 . I Y="N" D ADD^ORLP0 K ^XUTL("OR",$J,"ORLP"),^("ORV"),^("ORU"),^("ORW") S ORCNT=0 Q

 . I Y="W" D WARD^ORLP01 K ^XUTL("OR",$J,"ORLP"),^("ORV"),^("ORU"),^("ORW") S ORCNT=0 Q

 . I Y="C" D CLIN^ORLP01 K ^XUTL("OR",$J,"ORLP"),^("ORV"),^("ORU"),^("ORW") S ORCNT=0 Q

 . I Y="P" D PROV^ORLP01 K ^XUTL("OR",$J,"ORLP"),^("ORV"),^("ORU"),^("ORW") S ORCNT=0 Q

 . I Y="T" D SPEC^ORLP01 K ^XUTL("OR",$J,"ORLP"),^("ORV"),^("ORU"),^("ORW") S ORCNT=0 Q

 Q

ORLP00    ; slc/dcm,cla - Modify Patient Lists ;8/13/91  15:06

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997

DEL       ;Delete items from patient list

 +1        IF '$DATA(^XUTL("OR",$JOB,"ORLP"))

               WRITE !,"You must build a Patient List before using this option"

               QUIT 

L1         IF '$DATA(OROPREF)

               SET OROPREF=$$GET^XPAR("USR.`"_DUZ,"ORLP DEFAULT LIST ORDER",1,"I")

           SET ORUS="^XUTL(""OR"",$J,""ORLP"","

           SET ORUS(0)="40MN"

           SET ORUS("T")="W @IOF,?37,""PATIENT LIST"",! ;F I=1:1:IOM-1 W ""-"""

 +1        SET ORUS("W")="S X=$S(OROPREF=""R"":$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),""^"",5),1:"""")_"" ""_$P(^XUTL(""OR"",$J,""ORLP"",ORDA,0),""^"")_"" (""_$E($P(^(0),""^"",2),6,9)_"")"""

           SET ORUS("A")="Select Patient(s) to Remove: "

 +2        SET ORUS("F")="^XUTL(""OR"",$J,""ORLP"","""_$SELECT($LENGTH($PIECE(^XUTL("OR",$JOB,"ORLP",0),"^",3)):$PIECE(^(0),"^",3),1:"B")_""","

 +3        SET ORUS("H")="W !,""Enter a name, number or range separated by commas or a dash"""

 +4        DO EN^ORUS

 +5        IF ($DATA(Y)<10)

               DO END

               QUIT 

 +6        SET I=0

           WRITE !

 +7        FOR 

               SET I=$ORDER(Y(I))

               IF I<1

                   QUIT 

               IF $DATA(^XUTL("OR",$JOB,"ORLP",+Y(I),0))

                   SET X=^(0)

                   Begin DoDot:1

 +8                    KILL ^XUTL("OR",$JOB,"ORLP",+Y(I)),^XUTL("OR",$JOB,"ORLP","B",$PIECE(X,"^"),+Y(I)),^XUTL("OR",$JOB,"ORLP","C",$PIECE(X,"^",2),+Y(I))

                       WRITE !,"..."_$PIECE(Y(I),"^",2)_" removed"

                   End DoDot:1

 +9        KILL ^XUTL("OR",$JOB,"ORV"),^("ORU"),^("ORW")

           SET (C,I)=0

           FOR 

               SET I=$ORDER(^XUTL("OR",$JOB,"ORLP",I))

               IF I<1

                   QUIT 

               SET C=C+1

 +10       SET $PIECE(^XUTL("OR",$JOB,"ORLP",0),"^",4)=C

 +11       DO STOR^ORLP1

 +12       SET %=1

           WRITE !!,"Show modified working list"

           DO YN^DICN

           IF %=-1

               QUIT 

           IF %=1

               GOTO L1

 +13       DO END

 +14       QUIT 

END        KILL ORUS,OROPREF,Y

 +1        QUIT 

 +2       ;

ASKPT(TEAM) ;from ^ORLPL or internally - ask for patients

 +1        NEW Y,ORDIR

 +2        FOR 

               Begin DoDot:1

 +3                KILL DIR

                   SET DIR(0)="SO^N:NAME;W:WARD;C:CLINIC;P:PROVIDER;T:TREATING SPECIALTY"

 +4                SET DIR("A")="    to enter additional patients. (? for help)"

 +5                SET DIR("?",3)="a PROVIDER, or patients in a TREATING SPECIALTY."

 +6                SET DIR("?",1)="You may add patients to this list individually by patient NAME, or as a"

 +7                SET DIR("?",2)="group such as an entire WARD, patients in a CLINIC, all patients seeing"

 +8                SET DIR("?",4)=""

 +9                SET DIR("?",5)="                               ** CAUTION **"

 +10               SET DIR("?")="The patients added here will create a static list that will not change through MAS movements."

 +11               DO ^DIR

                   SET ORDIR=Y

                   KILL DIR

                   IF Y=""!(Y["^")

                       QUIT 

 +12               IF Y="N"

                       DO ADD^ORLP0

                       KILL ^XUTL("OR",$JOB,"ORLP"),^("ORV"),^("ORU"),^("ORW")

                       SET ORCNT=0

                       QUIT 

 +13               IF Y="W"

                       DO WARD^ORLP01

                       KILL ^XUTL("OR",$JOB,"ORLP"),^("ORV"),^("ORU"),^("ORW")

                       SET ORCNT=0

                       QUIT 

 +14               IF Y="C"

                       DO CLIN^ORLP01

                       KILL ^XUTL("OR",$JOB,"ORLP"),^("ORV"),^("ORU"),^("ORW")

                       SET ORCNT=0

                       QUIT 

 +15               IF Y="P"

                       DO PROV^ORLP01

                       KILL ^XUTL("OR",$JOB,"ORLP"),^("ORV"),^("ORU"),^("ORW")

                       SET ORCNT=0

                       QUIT 

 +16               IF Y="T"

                       DO SPEC^ORLP01

                       KILL ^XUTL("OR",$JOB,"ORLP"),^("ORV"),^("ORU"),^("ORW")

                       SET ORCNT=0

                       QUIT 

               End DoDot:1

               IF $DATA(DTOUT)!($DATA(DUOUT))!(ORDIR']"")

                   QUIT 

 +17       QUIT