- ORLPL ; slc/CLA - Display/Edit Patient Lists; 8/8/91
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- 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
- 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 END
- 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 END
- 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
- I $P(^OR(100.21,+LIST,0),U,2)="TA" D D END 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 END
- 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 END
- 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!"
- END K DA,DIC,DIK,ET,I,J,LIST,ORUS,RESP,Y
- Q
- ORLPL ; slc/CLA - Display/Edit Patient Lists; 8/8/91
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- 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 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: "
- +8 DO ^ORUS
- +9 IF ($DATA(Y)<10)
- GOTO END
- +10 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
- +11 NEW Y
- DO ^DIK
- End DoDot:1
- +12 WRITE !,"Provider/user(s) removed from list."
- +13 DO END
- +14 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 IF $PIECE(^OR(100.21,+LIST,0),U,2)="TA"
- Begin DoDot:1
- +7 SET A(1)=""
- SET A(2)="This 'TEAM PATIENT' list is an AUTOLINK list."
- +8 SET A(3)="In order to remove patients from this TEAM PATIENT list you must remove the"
- +9 SET A(4)="AUTOLINK(s)."
- SET A(5)=""
- DO EN^DDIOL(.A)
- KILL A
- +10 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 END
- QUIT
- +11 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: "
- +12 DO ^ORUS
- +13 IF ($DATA(Y)<10)
- GOTO END
- +14 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
- +15 NEW Y
- DO ^DIK
- End DoDot:1
- +16 WRITE !,"Patient(s) removed from list."
- +17 DO END
- +18 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!"
- END KILL DA,DIC,DIK,ET,I,J,LIST,ORUS,RESP,Y
- +1 QUIT
