source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLP0.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1ORLP0 ; SLC/DCM,CLA - Edit Patient Lists ; 11/18/92 [12/28/99 2:37pm]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,47**;Dec 17, 1997
3ADD ;from ASKPT^ORLP, optn ORLP ADD ONE - Add by individual pt, display number of patients added if not a TEAM list
4 D ASK(.X)
5 I (X<0)!(X>1) Q
6 D PREF
7 S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
8 S ORCT=0
9 K DIC
10 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
11 I ORCT'>0 W:'($D(TEAM)#2) !!,"No patients added.",! D END Q
12 D SEQ
13 Q
14SHOW ;from optn ORLP LIST - Show list
15 I '$L($O(^XUTL("OR",$J,"ORLP",0))) W !!,"No current list found.",! Q
16 I $L($O(^XUTL("OR",$J,"ORLP",0))) D L1
17 Q
18LIST ;from ORLP1, SEQ - List list
19 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
20L1 ;
21 N COL,HDR,PIE,ROOT
22 S ROOT="^XUTL(""OR"",$J,""ORLP"",""B"",",PIE="1",HDR="CURRENT PATIENT LIST",COL=3
23 D EN^ORULG(ROOT,PIE,HDR,COL)
24 Q
25END ;
26 K DIC,ORCOLW,ORDEF,ORCLIN,ORCEND,ORCSTRT,OREND,ORCNT,ORCT,ORI,ORII,ORJ,ORK,OROPREF,ORUS,ORUPNM,ORUSSN,ORVP,ORX,ORY,ORZ,Y
27 D:+$G(DUOUT)=1 CLEAR^ORLP
28 Q
29PERS ;from optn ORLP ADD LIST - add to existing lists, display number of patients added if not a TEAM list
30 I '$D(^OR(100.21,"C",DUZ)) W *7,!!,"You have no existing lists." Q
31 D ASK(.X)
32 I (X<0)!(X>1) Q
33 S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
34 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: "
35 F ORI=0:0 S ORCT=0 D P1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
36 I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! D END Q
37 D SEQ
38 Q
39P1 ;
40 D ^DIC
41 S ORY=Y
42 Q:+Y<1
43 I $O(^OR(100.21,+Y,10,0))="" W !!,"Patient list "_$P(Y,"^",2)_" is empty." S Y=0 Q
44 W !!,"Working..."
45 S ORJ=0
46 D PREF
47 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)
48 Q
49ASK(X) ;
50 I $D(TEAM)#2 S X=1 Q ;quit if processing a TEAM list
51 K ORTITLE
52 I '($D(^XUTL("OR",$J,"ORLP",0))#2) W !,"No existing list found, continuing with an EMPTY list.",! S X=1 Q
53 S:$D(^XUTL("OR",$J,"ORLP",0))#2 ORCNT=$P(^(0),"^",4),$P(^(0),"^",2)=""
54 K ^XUTL("OR",$J,"ORV"),^("ORW"),^("ORU")
55 S %=0
56 F D Q:%
57 . W !!,"A Patient list is currently defined."
58 . W:$D(ORCNT) " ("_ORCNT_" patient(s))"
59 . W !,"Do you want to continue with the current list"
60 . S %=1 D YN^DICN
61 . I %=-1 S X=% Q
62 . I %=0 W !,"Enter YES or NO."
63 . I %=2 D CLEAR^ORLP1(.X) Q
64 W !!,"Continuing with current list."
65 S X=%
66 Q
67SEQ ;
68 I '$D(OROPREF) D PREF
69 S $P(^XUTL("OR",$J,"ORLP",0),"^",4)=ORCNT,$P(^(0),"^",3)=$S(OROPREF="T":"C",OROPREF="R":"D",1:"B")
70 I '($D(TEAM)#2) D LIST I $D(%),(%=-1) Q ;if not a TEAM list DO LIST
71SEQ1 ;
72 I '($D(TEAM)#2) D REM I $D(%),(%=-1) Q ;if not a TEAM list DO REM
73 D @$S($D(TEAM)#2:"STOR^ORLP",1:"STOR^ORLP1"),END ;if a TEAM list DO STOR^ORLP
74 Q
75REM ;
76 S %=2
77 W !!,"Do you want to remove patients from this list"
78 D YN^DICN Q:%=-1
79 I %=0 W !,"Enter YES or NO." G REM
80 I $G(%)=1 D DEL^ORLP00
81 Q
82PREF ;
83 S OROPREF=$$GET^XPAR("USR.`"_DUZ,"ORLP DEFAULT LIST ORDER",1,"I")
84 Q
85OKILL ; called by options ORLP ADD LIST, ORLP ADD ONE, ORLP ADD PROVIDER, ORLP ADD SPECIALTY, ORLP ADD WARD, ORLP LOAD, ORPO PATIENT SELECT
86 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
87 Q
Note: See TracBrowser for help on using the repository browser.