Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORLP0

ORLP0.m

Go to the documentation of this file.
  1. 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
  1. ADD ;from ASKPT^ORLP, optn ORLP ADD ONE - Add by individual pt, display number of patients added if not a TEAM list
  1. D ASK(.X)
  1. I (X<0)!(X>1) Q
  1. D PREF
  1. S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
  1. S ORCT=0
  1. K DIC
  1. 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
  1. I ORCT'>0 W:'($D(TEAM)#2) !!,"No patients added.",! D END Q
  1. D SEQ
  1. Q
  1. SHOW ;from optn ORLP LIST - Show list
  1. I '$L($O(^XUTL("OR",$J,"ORLP",0))) W !!,"No current list found.",! Q
  1. I $L($O(^XUTL("OR",$J,"ORLP",0))) D L1
  1. Q
  1. LIST ;from ORLP1, SEQ - List list
  1. 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
  1. L1 ;
  1. N COL,HDR,PIE,ROOT
  1. S ROOT="^XUTL(""OR"",$J,""ORLP"",""B"",",PIE="1",HDR="CURRENT PATIENT LIST",COL=3
  1. D EN^ORULG(ROOT,PIE,HDR,COL)
  1. Q
  1. END ;
  1. K DIC,ORCOLW,ORDEF,ORCLIN,ORCEND,ORCSTRT,OREND,ORCNT,ORCT,ORI,ORII,ORJ,ORK,OROPREF,ORUS,ORUPNM,ORUSSN,ORVP,ORX,ORY,ORZ,Y
  1. D:+$G(DUOUT)=1 CLEAR^ORLP
  1. Q
  1. PERS ;from optn ORLP ADD LIST - add to existing lists, display number of patients added if not a TEAM list
  1. I '$D(^OR(100.21,"C",DUZ)) W *7,!!,"You have no existing lists." Q
  1. D ASK(.X)
  1. I (X<0)!(X>1) Q
  1. S:'$D(ORCNT) ORCNT=$S($D(^XUTL("OR",$J,"ORLP",0)):+$P(^(0),"^",4),1:0)
  1. 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: "
  1. F ORI=0:0 S ORCT=0 D P1 Q:+ORY<1 I ORCNT>0 W:'($D(TEAM)#2) !!,ORCT_" Patients added, "_ORCNT_" total"
  1. I $G(DUOUT)=1!(ORCNT'>0) W:'($D(TEAM)#2) !!,"No patients added.",! D END Q
  1. D SEQ
  1. Q
  1. P1 ;
  1. D ^DIC
  1. S ORY=Y
  1. Q:+Y<1
  1. I $O(^OR(100.21,+Y,10,0))="" W !!,"Patient list "_$P(Y,"^",2)_" is empty." S Y=0 Q
  1. W !!,"Working..."
  1. S ORJ=0
  1. D PREF
  1. 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)
  1. Q
  1. ASK(X) ;
  1. I $D(TEAM)#2 S X=1 Q ;quit if processing a TEAM list
  1. K ORTITLE
  1. I '($D(^XUTL("OR",$J,"ORLP",0))#2) W !,"No existing list found, continuing with an EMPTY list.",! S X=1 Q
  1. S:$D(^XUTL("OR",$J,"ORLP",0))#2 ORCNT=$P(^(0),"^",4),$P(^(0),"^",2)=""
  1. K ^XUTL("OR",$J,"ORV"),^("ORW"),^("ORU")
  1. S %=0
  1. F D Q:%
  1. . W !!,"A Patient list is currently defined."
  1. . W:$D(ORCNT) " ("_ORCNT_" patient(s))"
  1. . W !,"Do you want to continue with the current list"
  1. . S %=1 D YN^DICN
  1. . I %=-1 S X=% Q
  1. . I %=0 W !,"Enter YES or NO."
  1. . I %=2 D CLEAR^ORLP1(.X) Q
  1. W !!,"Continuing with current list."
  1. S X=%
  1. Q
  1. SEQ ;
  1. I '$D(OROPREF) D PREF
  1. S $P(^XUTL("OR",$J,"ORLP",0),"^",4)=ORCNT,$P(^(0),"^",3)=$S(OROPREF="T":"C",OROPREF="R":"D",1:"B")
  1. I '($D(TEAM)#2) D LIST I $D(%),(%=-1) Q ;if not a TEAM list DO LIST
  1. SEQ1 ;
  1. I '($D(TEAM)#2) D REM I $D(%),(%=-1) Q ;if not a TEAM list DO REM
  1. D @$S($D(TEAM)#2:"STOR^ORLP",1:"STOR^ORLP1"),END ;if a TEAM list DO STOR^ORLP
  1. Q
  1. REM ;
  1. S %=2
  1. W !!,"Do you want to remove patients from this list"
  1. D YN^DICN Q:%=-1
  1. I %=0 W !,"Enter YES or NO." G REM
  1. I $G(%)=1 D DEL^ORLP00
  1. Q
  1. PREF ;
  1. S OROPREF=$$GET^XPAR("USR.`"_DUZ,"ORLP DEFAULT LIST ORDER",1,"I")
  1. Q
  1. 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. 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
  1. Q