ORLP0 ; SLC/DCM,CLA - Edit Patient Lists ; 11/18/92 [12/28/99 2:37pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,47**;Dec 17, 1997
ADD ;from ASKPT^ORLP, optn ORLP ADD ONE - Add by individual pt, display number of patients added if not a TEAM list
D ASK(.X)
I (X<0)!(X>1) Q
D PREF
S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
S ORCT=0
K DIC
F ORII=0:0 W ! D EN2^ORUDPA Q:'ORVP!(+ORVP<1) S ORX="" D PR1^ORLA1(ORVP,OROPREF) W:'($D(TEAM)#2) !?4,"Patient "_ORPNM_" added" S ORCT=1
I ORCT'>0 W:'($D(TEAM)#2) !!,"No patients added.",! D END Q
D SEQ
Q
SHOW ;from optn ORLP LIST - Show list
I '$L($O(^XUTL("OR",$J,"ORLP",0))) W !!,"No current list found.",! Q
I $L($O(^XUTL("OR",$J,"ORLP",0))) D L1
Q
LIST ;from ORLP1, SEQ - List list
I $L($O(^XUTL("OR",$J,"ORLP",0))) W !!,"Show your current PATIENT list" S %=2 D YN^DICN Q:%=2 Q:%=-1 I %=0 W !,"Enter YES or NO." G LIST
L1 ;
N COL,HDR,PIE,ROOT
S ROOT="^XUTL(""OR"",$J,""ORLP"",""B"",",PIE="1",HDR="CURRENT PATIENT LIST",COL=3
D EN^ORULG(ROOT,PIE,HDR,COL)
Q
END ;
K DIC,ORCOLW,ORDEF,ORCLIN,ORCEND,ORCSTRT,OREND,ORCNT,ORCT,ORI,ORII,ORJ,ORK,OROPREF,ORUS,ORUPNM,ORUSSN,ORVP,ORX,ORY,ORZ,Y
D:+$G(DUOUT)=1 CLEAR^ORLP
Q
PERS ;from optn ORLP ADD LIST - add to existing lists, display number of patients added if not a TEAM list
I '$D(^OR(100.21,"C",DUZ)) W *7,!!,"You have no existing lists." Q
D ASK(.X)
I (X<0)!(X>1) Q
S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
S DIC="^OR(100.21,",DIC(0)="AEQM",DIC("S")="I $P(^(0),U,2)=""P"",$D(^(1,DUZ))",DIC("A")="Select Personal PATIENT LIST: "
F ORI=0:0 S ORCT=0 D P1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! D END Q
D SEQ
Q
P1 ;
D ^DIC
S ORY=Y
Q:+Y<1
I $O(^OR(100.21,+Y,10,0))="" W !!,"Patient list "_$P(Y,"^",2)_" is empty." S Y=0 Q
W !!,"Working..."
S ORJ=0
D PREF
F ORI=0:0 S ORJ=$O(^OR(100.21,+ORY,10,ORJ)) Q:ORJ<1 S ORX=^(ORJ,0),ORVP=$P(ORX,"^") D PR1^ORLA1(ORVP,OROPREF)
Q
ASK(X) ;
I $D(TEAM)#2 S X=1 Q ;quit if processing a TEAM list
K ORTITLE
I '($D(^XUTL("OR",$J,"ORLP",0))#2) W !,"No existing list found, continuing with an EMPTY list.",! S X=1 Q
S:$D(^XUTL("OR",$J,"ORLP",0))#2 ORCNT=$P(^(0),"^",4),$P(^(0),"^",2)=""
K ^XUTL("OR",$J,"ORV"),^("ORW"),^("ORU")
S %=0
F D Q:%
. W !!,"A Patient list is currently defined."
. W:$D(ORCNT) " ("_ORCNT_" patient(s))"
. W !,"Do you want to continue with the current list"
. S %=1 D YN^DICN
. I %=-1 S X=% Q
. I %=0 W !,"Enter YES or NO."
. I %=2 D CLEAR^ORLP1(.X) Q
W !!,"Continuing with current list."
S X=%
Q
SEQ ;
I '$D(OROPREF) D PREF
S $P(^XUTL("OR",$J,"ORLP",0),"^",4)=ORCNT,$P(^(0),"^",3)=$S(OROPREF="T":"C",OROPREF="R":"D",1:"B")
I '($D(TEAM)#2) D LIST I $D(%),(%=-1) Q ;if not a TEAM list DO LIST
SEQ1 ;
I '($D(TEAM)#2) D REM I $D(%),(%=-1) Q ;if not a TEAM list DO REM
D @$S($D(TEAM)#2:"STOR^ORLP",1:"STOR^ORLP1"),END ;if a TEAM list DO STOR^ORLP
Q
REM ;
S %=2
W !!,"Do you want to remove patients from this list"
D YN^DICN Q:%=-1
I %=0 W !,"Enter YES or NO." G REM
I $G(%)=1 D DEL^ORLP00
Q
PREF ;
S OROPREF=$$GET^XPAR("USR.`"_DUZ,"ORLP DEFAULT LIST ORDER",1,"I")
Q
OKILL ; called by options ORLP ADD LIST, ORLP ADD ONE, ORLP ADD PROVIDER, ORLP ADD SPECIALTY, ORLP ADD WARD, ORLP LOAD, ORPO PATIENT SELECT
K ORACTION,ORAGE,ORATTEND,ORCEND,ORCLIN,ORCNT,ORCOLW,ORCSTRT,ORDEF,ORDIC,ORDOB,ORGY,ORI,ORL,ORNP,OROPREF,ORPD,ORPNM,ORPRIM,ORPROV,ORPV,ORSEX,ORSPEC,ORSSN,ORTITLE,ORTS,ORUPNM,ORURMBD,ORUSSN,ORUVP,ORVP,ORWARD,ORX,ORY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLP0 3689 printed Sep 23, 2025@20:07:37 Page 2
ORLP0 ; SLC/DCM,CLA - Edit Patient Lists ; 11/18/92 [12/28/99 2:37pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,47**;Dec 17, 1997
ADD ;from ASKPT^ORLP, optn ORLP ADD ONE - Add by individual pt, display number of patients added if not a TEAM list
+1 DO ASK(.X)
+2 IF (X<0)!(X>1)
QUIT
+3 DO PREF
+4 if '$DATA(ORCNT)
SET ORCNT=$SELECT($DATA(^XUTL("OR",$JOB,"ORLP",0)):+$PIECE(^(0),"^",4),1:0)
+5 SET ORCT=0
+6 KILL DIC
+7 FOR ORII=0:0
WRITE !
DO EN2^ORUDPA
if 'ORVP!(+ORVP<1)
QUIT
SET ORX=""
DO PR1^ORLA1(ORVP,OROPREF)
if '($DATA(TEAM)#2)
WRITE !?4,"Patient "_ORPNM_" added"
SET ORCT=1
+8 IF ORCT'>0
if '($DATA(TEAM)#2)
WRITE !!,"No patients added.",!
DO END
QUIT
+9 DO SEQ
+10 QUIT
SHOW ;from optn ORLP LIST - Show list
+1 IF '$LENGTH($ORDER(^XUTL("OR",$JOB,"ORLP",0)))
WRITE !!,"No current list found.",!
QUIT
+2 IF $LENGTH($ORDER(^XUTL("OR",$JOB,"ORLP",0)))
DO L1
+3 QUIT
LIST ;from ORLP1, SEQ - List list
+1 IF $LENGTH($ORDER(^XUTL("OR",$JOB,"ORLP",0)))
WRITE !!,"Show your current PATIENT list"
SET %=2
DO YN^DICN
if %=2
QUIT
if %=-1
QUIT
IF %=0
WRITE !,"Enter YES or NO."
GOTO LIST
L1 ;
+1 NEW COL,HDR,PIE,ROOT
+2 SET ROOT="^XUTL(""OR"",$J,""ORLP"",""B"","
SET PIE="1"
SET HDR="CURRENT PATIENT LIST"
SET COL=3
+3 DO EN^ORULG(ROOT,PIE,HDR,COL)
+4 QUIT
END ;
+1 KILL DIC,ORCOLW,ORDEF,ORCLIN,ORCEND,ORCSTRT,OREND,ORCNT,ORCT,ORI,ORII,ORJ,ORK,OROPREF,ORUS,ORUPNM,ORUSSN,ORVP,ORX,ORY,ORZ,Y
+2 if +$GET(DUOUT)=1
DO CLEAR^ORLP
+3 QUIT
PERS ;from optn ORLP ADD LIST - add to existing lists, display number of patients added if not a TEAM list
+1 IF '$DATA(^OR(100.21,"C",DUZ))
WRITE *7,!!,"You have no existing lists."
QUIT
+2 DO ASK(.X)
+3 IF (X<0)!(X>1)
QUIT
+4 if '$DATA(ORCNT)
SET ORCNT=$SELECT($DATA(^XUTL("OR",$JOB,"ORLP",0)):+$PIECE(^(0),"^",4),1:0)
+5 SET DIC="^OR(100.21,"
SET DIC(0)="AEQM"
SET DIC("S")="I $P(^(0),U,2)=""P"",$D(^(1,DUZ))"
SET DIC("A")="Select Personal PATIENT LIST: "
+6 FOR ORI=0:0
SET ORCT=0
DO P1
if +ORY<1
QUIT
IF ORCNT>0
if '($DATA(TEAM)#2)
WRITE !!,ORCT_" Patients added, "_ORCNT_" total"
+7 IF $GET(DUOUT)=1!(ORCNT'>0)
if '($DATA(TEAM)#2)
WRITE !!,"No patients added.",!
DO END
QUIT
+8 DO SEQ
+9 QUIT
P1 ;
+1 DO ^DIC
+2 SET ORY=Y
+3 if +Y<1
QUIT
+4 IF $ORDER(^OR(100.21,+Y,10,0))=""
WRITE !!,"Patient list "_$PIECE(Y,"^",2)_" is empty."
SET Y=0
QUIT
+5 WRITE !!,"Working..."
+6 SET ORJ=0
+7 DO PREF
+8 FOR ORI=0:0
SET ORJ=$ORDER(^OR(100.21,+ORY,10,ORJ))
if ORJ<1
QUIT
SET ORX=^(ORJ,0)
SET ORVP=$PIECE(ORX,"^")
DO PR1^ORLA1(ORVP,OROPREF)
+9 QUIT
ASK(X) ;
+1 ;quit if processing a TEAM list
IF $DATA(TEAM)#2
SET X=1
QUIT
+2 KILL ORTITLE
+3 IF '($DATA(^XUTL("OR",$JOB,"ORLP",0))#2)
WRITE !,"No existing list found, continuing with an EMPTY list.",!
SET X=1
QUIT
+4 if $DATA(^XUTL("OR",$JOB,"ORLP",0))#2
SET ORCNT=$PIECE(^(0),"^",4)
SET $PIECE(^(0),"^",2)=""
+5 KILL ^XUTL("OR",$JOB,"ORV"),^("ORW"),^("ORU")
+6 SET %=0
+7 FOR
Begin DoDot:1
+8 WRITE !!,"A Patient list is currently defined."
+9 if $DATA(ORCNT)
WRITE " ("_ORCNT_" patient(s))"
+10 WRITE !,"Do you want to continue with the current list"
+11 SET %=1
DO YN^DICN
+12 IF %=-1
SET X=%
QUIT
+13 IF %=0
WRITE !,"Enter YES or NO."
+14 IF %=2
DO CLEAR^ORLP1(.X)
QUIT
End DoDot:1
if %
QUIT
+15 WRITE !!,"Continuing with current list."
+16 SET X=%
+17 QUIT
SEQ ;
+1 IF '$DATA(OROPREF)
DO PREF
+2 SET $PIECE(^XUTL("OR",$JOB,"ORLP",0),"^",4)=ORCNT
SET $PIECE(^(0),"^",3)=$SELECT(OROPREF="T":"C",OROPREF="R":"D",1:"B")
+3 ;if not a TEAM list DO LIST
IF '($DATA(TEAM)#2)
DO LIST
IF $DATA(%)
IF (%=-1)
QUIT
SEQ1 ;
+1 ;if not a TEAM list DO REM
IF '($DATA(TEAM)#2)
DO REM
IF $DATA(%)
IF (%=-1)
QUIT
+2 ;if a TEAM list DO STOR^ORLP
DO @$SELECT($DATA(TEAM)#2:"STOR^ORLP",1:"STOR^ORLP1")
DO END
+3 QUIT
REM ;
+1 SET %=2
+2 WRITE !!,"Do you want to remove patients from this list"
+3 DO YN^DICN
if %=-1
QUIT
+4 IF %=0
WRITE !,"Enter YES or NO."
GOTO REM
+5 IF $GET(%)=1
DO DEL^ORLP00
+6 QUIT
PREF ;
+1 SET OROPREF=$$GET^XPAR("USR.`"_DUZ,"ORLP DEFAULT LIST ORDER",1,"I")
+2 QUIT
OKILL ; called by options ORLP ADD LIST, ORLP ADD ONE, ORLP ADD PROVIDER, ORLP ADD SPECIALTY, ORLP ADD WARD, ORLP LOAD, ORPO PATIENT SELECT
+1 KILL ORACTION,ORAGE,ORATTEND,ORCEND,ORCLIN,ORCNT,ORCOLW,ORCSTRT,ORDEF,ORDIC,ORDOB,ORGY,ORI,ORL,ORNP,OROPREF,ORPD,ORPNM,ORPRIM,ORPROV,ORPV,ORSEX,ORSPEC,ORSSN,ORTITLE,ORTS,ORUPNM,ORURMBD,ORUSSN,ORUVP,ORVP,ORWARD,ORX,ORY
+2 QUIT
