- 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