- 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 Jan 18, 2025@03:32:27 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