ORLPL ; slc/CLA - Display/Edit Patient Lists; 8/8/91
;;3.0;ORDER ENTRY/RESULTS REPORTING;**273**;Dec 17, 1997;Build 17
;;Per VHA Directive 2004-038, this routine should not be modified
;
;DBIA reference section
;10142 - EN^DDIOL
;10006 - DIC
;10013 - DIK
;10026 - DIR
;2263 - XPAR
;
GETDEF ;called by SETUP, ASKLIST^ORLP, INQ^ORLP1 - get a default list from ^TMP or user's primary list
N LST
I $D(^TMP("ORLP",$J,"TLIST")) S DIC("B")=^TMP("ORLP",$J,"TLIST") Q
;if user has a primary list defined, its type is team, users are defined and the current user is on the list, use the primary list as the default
S LST=$$GET^XPAR("USR.`"_DUZ,"ORLP DEFAULT TEAM",1,"I") I +$G(LST)>0,$D(^OR(100.21,LST,0)) S DIC("B")=$P(^(0),U)
Q
SETUP ;called by DELUSER, DELPT - setup list for display and editing
S LIST=Y,^TMP("ORLP",$J,"TLIST")=+Y
K DIC,^XUTL("OR",$J),Y
Q
DELUSER ;called by option ORLP DELETE TEAM USERS - removes provider/users from a list
S ET="U",DIC="^OR(100.21,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,2)'=""P""",DIC("A")="Select TEAM PATIENT list: "
D ^DIC I Y<1 D END Q
D SETUP
;if no users on list goto NOENTRY
I '$D(^OR(100.21,+LIST,1,0)) G NOENTRY
I $P(^OR(100.21,+LIST,1,0),"^",4)=""!($P(^(0),"^",4)=0) G NOENTRY
L +^OR(100.21,+LIST):$G(DILOCKTM,3) ; Lock the file at the Team List level.
I ('$TEST) W !,"Another user is editing this entry." D END Q ; Punt if there's a file locking conflict.
S ORUS="^OR(100.21,+LIST,1,",ORUS(0)="40MN",ORUS("T")="W @IOF,?34,""OWNER LIST"",!",ORUS("A")="Enter Provider/user(s) to REMOVE from list: "
D ^ORUS
I ($D(Y)<10) G ULEND
S I=0 W ! F S I=$O(Y(I)) Q:I<1 S DA(1)=+LIST,DA=+Y(I),DIK="^OR(100.21,"_DA(1)_",1," D
. N Y D ^DIK
W !,"Provider/user(s) removed from list."
D ULEND
Q
DELPT ;called by option ORLP DELETE TEAM PATIENTS - removes patients from a list
S ET="P",DIC="^OR(100.21,",DIC(0)="AEMQ",DIC("S")="I $P(^(0),U,2)[""M""",DIC("A")="Select TEAM PATIENT list: "
D ^DIC I Y<1 D END Q
D SETUP
;if no patients on list goto NOENTRY
I '$O(^OR(100.21,+LIST,10,0)) G NOENTRY
L +^OR(100.21,+LIST):$G(DILOCKTM,3) ; Lock the file at the Team List level.
I ('$TEST) W !,"Another user is editing this entry." D END Q ; Punt if there's a file locking conflict.
I $P(^OR(100.21,+LIST,0),U,2)="TA" D D ULEND Q
. S A(1)="",A(2)="This 'TEAM PATIENT' list is an AUTOLINK list."
. S A(3)="In order to remove patients from this TEAM PATIENT list you must remove the"
. S A(4)="AUTOLINK(s).",A(5)="" D EN^DDIOL(.A) K A
. S DIR(0)="YO",DIR("A")="Do you want to remove Autolinks",DIR("B")="Y" D ^DIR K DIR Q:$D(DIROUT) I Y=1 D ASKLINK^ORLP2(+LIST)
S ORUS="^OR(100.21,+LIST,10,",ORUS(0)="40MN",ORUS("T")="W @IOF,?32,""PATIENT LIST"",!",ORUS("A")="Enter patient(s) to REMOVE from list: "
D ^ORUS
I ($D(Y)<10) G ULEND
S I=0 W ! F S I=$O(Y(I)) Q:I<1 S DA(1)=+LIST,DA=+Y(I),DIK="^OR(100.21,"_DA(1)_",10," D
. N Y D ^DIK
W !,"Patient(s) removed from list."
D ULEND
Q
NOENTRY ;called by DELUSER, DELPT - indicate no entries in file/record/field
W !!,"There are no ",$S(ET="U":"provider/user ",ET="P":"patient ",1:""),"entries in this list to edit!"
ULEND I $G(LIST) L -^OR(100.21,+LIST)
END K DA,DIC,DIK,ET,I,J,LIST,ORUS,RESP,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLPL 3276 printed Sep 23, 2025@20:07:50 Page 2
ORLPL ; slc/CLA - Display/Edit Patient Lists; 8/8/91
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**273**;Dec 17, 1997;Build 17
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
+4 ;DBIA reference section
+5 ;10142 - EN^DDIOL
+6 ;10006 - DIC
+7 ;10013 - DIK
+8 ;10026 - DIR
+9 ;2263 - XPAR
+10 ;
GETDEF ;called by SETUP, ASKLIST^ORLP, INQ^ORLP1 - get a default list from ^TMP or user's primary list
+1 NEW LST
+2 IF $DATA(^TMP("ORLP",$JOB,"TLIST"))
SET DIC("B")=^TMP("ORLP",$JOB,"TLIST")
QUIT
+3 ;if user has a primary list defined, its type is team, users are defined and the current user is on the list, use the primary list as the default
+4 SET LST=$$GET^XPAR("USR.`"_DUZ,"ORLP DEFAULT TEAM",1,"I")
IF +$GET(LST)>0
IF $DATA(^OR(100.21,LST,0))
SET DIC("B")=$PIECE(^(0),U)
+5 QUIT
SETUP ;called by DELUSER, DELPT - setup list for display and editing
+1 SET LIST=Y
SET ^TMP("ORLP",$JOB,"TLIST")=+Y
+2 KILL DIC,^XUTL("OR",$JOB),Y
+3 QUIT
DELUSER ;called by option ORLP DELETE TEAM USERS - removes provider/users from a list
+1 SET ET="U"
SET DIC="^OR(100.21,"
SET DIC(0)="AEMQ"
SET DIC("S")="I $P(^(0),U,2)'=""P"""
SET DIC("A")="Select TEAM PATIENT list: "
+2 DO ^DIC
IF Y<1
DO END
QUIT
+3 DO SETUP
+4 ;if no users on list goto NOENTRY
+5 IF '$DATA(^OR(100.21,+LIST,1,0))
GOTO NOENTRY
+6 IF $PIECE(^OR(100.21,+LIST,1,0),"^",4)=""!($PIECE(^(0),"^",4)=0)
GOTO NOENTRY
+7 ; Lock the file at the Team List level.
LOCK +^OR(100.21,+LIST):$GET(DILOCKTM,3)
+8 ; Punt if there's a file locking conflict.
IF ('$TEST)
WRITE !,"Another user is editing this entry."
DO END
QUIT
+9 SET ORUS="^OR(100.21,+LIST,1,"
SET ORUS(0)="40MN"
SET ORUS("T")="W @IOF,?34,""OWNER LIST"",!"
SET ORUS("A")="Enter Provider/user(s) to REMOVE from list: "
+10 DO ^ORUS
+11 IF ($DATA(Y)<10)
GOTO ULEND
+12 SET I=0
WRITE !
FOR
SET I=$ORDER(Y(I))
if I<1
QUIT
SET DA(1)=+LIST
SET DA=+Y(I)
SET DIK="^OR(100.21,"_DA(1)_",1,"
Begin DoDot:1
+13 NEW Y
DO ^DIK
End DoDot:1
+14 WRITE !,"Provider/user(s) removed from list."
+15 DO ULEND
+16 QUIT
DELPT ;called by option ORLP DELETE TEAM PATIENTS - removes patients from a list
+1 SET ET="P"
SET DIC="^OR(100.21,"
SET DIC(0)="AEMQ"
SET DIC("S")="I $P(^(0),U,2)[""M"""
SET DIC("A")="Select TEAM PATIENT list: "
+2 DO ^DIC
IF Y<1
DO END
QUIT
+3 DO SETUP
+4 ;if no patients on list goto NOENTRY
+5 IF '$ORDER(^OR(100.21,+LIST,10,0))
GOTO NOENTRY
+6 ; Lock the file at the Team List level.
LOCK +^OR(100.21,+LIST):$GET(DILOCKTM,3)
+7 ; Punt if there's a file locking conflict.
IF ('$TEST)
WRITE !,"Another user is editing this entry."
DO END
QUIT
+8 IF $PIECE(^OR(100.21,+LIST,0),U,2)="TA"
Begin DoDot:1
+9 SET A(1)=""
SET A(2)="This 'TEAM PATIENT' list is an AUTOLINK list."
+10 SET A(3)="In order to remove patients from this TEAM PATIENT list you must remove the"
+11 SET A(4)="AUTOLINK(s)."
SET A(5)=""
DO EN^DDIOL(.A)
KILL A
+12 SET DIR(0)="YO"
SET DIR("A")="Do you want to remove Autolinks"
SET DIR("B")="Y"
DO ^DIR
KILL DIR
if $DATA(DIROUT)
QUIT
IF Y=1
DO ASKLINK^ORLP2(+LIST)
End DoDot:1
DO ULEND
QUIT
+13 SET ORUS="^OR(100.21,+LIST,10,"
SET ORUS(0)="40MN"
SET ORUS("T")="W @IOF,?32,""PATIENT LIST"",!"
SET ORUS("A")="Enter patient(s) to REMOVE from list: "
+14 DO ^ORUS
+15 IF ($DATA(Y)<10)
GOTO ULEND
+16 SET I=0
WRITE !
FOR
SET I=$ORDER(Y(I))
if I<1
QUIT
SET DA(1)=+LIST
SET DA=+Y(I)
SET DIK="^OR(100.21,"_DA(1)_",10,"
Begin DoDot:1
+17 NEW Y
DO ^DIK
End DoDot:1
+18 WRITE !,"Patient(s) removed from list."
+19 DO ULEND
+20 QUIT
NOENTRY ;called by DELUSER, DELPT - indicate no entries in file/record/field
+1 WRITE !!,"There are no ",$SELECT(ET="U":"provider/user ",ET="P":"patient ",1:""),"entries in this list to edit!"
ULEND IF $GET(LIST)
LOCK -^OR(100.21,+LIST)
END KILL DA,DIC,DIK,ET,I,J,LIST,ORUS,RESP,Y
+1 QUIT
