ORLPAUT0 ; slc/CLA - Automatically load patients into lists ;2/12/92
;;3.0;ORDER ENTRY/RESULTS REPORTING;**247**;Dec 17, 1997
Q
EN ;called by protocol ORU AUTOLIST - automatically update lists with AUTOLINK set.
Q:'$D(DGPMT)!('$D(DFN)) S TYPE=DGPMT
W !!,"Updating automated team lists..."
K VAINDT S VA200=1 D INP^VADPT ;regenerate VAIN array to get NEW PERSON primary provider (and in some cases other protocols kill VAIN)
D DELPT
W "completed."
EXIT K DIK,EN,LINK,ORLIST,PROV,RB,TYPE,VA200
Q
DELPT ;called by EN - remove patient from autolists
S ORLIST=0
F S ORLIST=$O(^OR(100.21,"AB",DFN_";DPT(",ORLIST)) Q:ORLIST'>0 D
. I $P(^OR(100.21,ORLIST,0),U,2)'="TA" Q
. ; type TA is a total autolinked list removal and addition, LEAVE the others ALONE
. S DA=$O(^OR(100.21,ORLIST,10,"B",DFN_";DPT(",0))
. S DA(1)=ORLIST,DIK="^OR(100.21,"_DA(1)_",10," D ^DIK K DA,DIK
; Q:(TYPE=3) ;quit if discharge not working for ASIH. removed 11-94 mrh
UPDATE ; flow thru from DELPT - update autolists
Q:'VAIN(1) ; not a vaild movement
I $G(VAIN(4)) S LINK=$P(VAIN(4),"^")_";DIC(42," D ADDPT ;ward
S RB=$G(VAIN(5)) I $D(RB),RB'="" S EN=0 D
.S EN=$O(^DG(405.4,"B",RB,EN)) Q:EN'>0
.S LINK=EN_";DG(405.4," D ADDPT ;room-bed
I $G(VAIN(3)) S LINK=$P(VAIN(3),"^")_";DIC(45.7," D ADDPT ;treating specialty
I $G(VAIN(2)) S LINK=$P(VAIN(2),"^")_";VA(200," D ADDPT1("PB") ;primary provider
I $G(VAIN(11)) S LINK=$P(VAIN(11),"^")_";VA(200," D ADDPT1("AB") ;attending dr
Q
ADDPT ;called by UPDATE - add patient to autolists
; for WARD, ROOM-BED and TREATING SPECIALITY
S ORLIST=0
F S ORLIST=$O(^OR(100.21,"AC",LINK,ORLIST)) Q:ORLIST'>0 D
. I $P(^OR(100.21,ORLIST,0),U,2)'["A" Q
. ;list types TA and MRAL are auto add the others are manual
. I $D(^OR(100.21,ORLIST,10,"B",DFN_";DPT(")) Q ;quit if patient already on list
. I '$D(^OR(100.21,ORLIST,10,0)) S ^(0)="^100.2101AV^^"
. K DIC,DA,DO,DD,DINUM ;added DINUM in 247
. S DLAYGO=100.21,DA(1)=ORLIST,DIC="^OR(100.21,"_DA(1)_",10,",DIC(0)="L",X=DFN_";DPT("
. D FILE^DICN
. K DA,DD,DIC,DLAYGO,DO,X,DINUM ;added DINUM in 247
Q
ADDPT1(LTYPE) ; called by UPDATE - add patient to autolists
; for primary attending or both (LTYPE)
I LTYPE']"" Q
I '+LINK Q
S ORLIST=0
F S ORLIST=$O(^OR(100.21,"AC",LINK,ORLIST)) Q:ORLIST'>0 D
. I $P(^OR(100.21,ORLIST,0),U,2)'["A" Q
. I $D(^OR(100.21,ORLIST,10,"B",DFN_";DPT(")) Q ;quit if patient already on list
. S PROV=0 F S PROV=$O(^OR(100.21,ORLIST,2,"B",LINK,PROV)) Q:PROV'>0 D
.. I LTYPE[$P($G(^OR(100.21,ORLIST,2,PROV,0)),U,2) D FILE
Q
FILE ;
I '$D(^OR(100.21,ORLIST,10,0)) S ^(0)="^100.2101AV^^"
K DIC,DA,DO,DD,DINUM ;added DINUM in 247
S DLAYGO=100.21,DA(1)=ORLIST,DIC="^OR(100.21,"_DA(1)_",10,",DIC(0)="L",X=DFN_";DPT("
D FILE^DICN
K DA,DD,DIC,DLAYGO,DO,X,DINUM ;added DINUM in 247
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLPAUT0 2871 printed Sep 23, 2025@20:07:49 Page 2
ORLPAUT0 ; slc/CLA - Automatically load patients into lists ;2/12/92
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**247**;Dec 17, 1997
+2 QUIT
EN ;called by protocol ORU AUTOLIST - automatically update lists with AUTOLINK set.
+1 if '$DATA(DGPMT)!('$DATA(DFN))
QUIT
SET TYPE=DGPMT
+2 WRITE !!,"Updating automated team lists..."
+3 ;regenerate VAIN array to get NEW PERSON primary provider (and in some cases other protocols kill VAIN)
KILL VAINDT
SET VA200=1
DO INP^VADPT
+4 DO DELPT
+5 WRITE "completed."
EXIT KILL DIK,EN,LINK,ORLIST,PROV,RB,TYPE,VA200
+1 QUIT
DELPT ;called by EN - remove patient from autolists
+1 SET ORLIST=0
+2 FOR
SET ORLIST=$ORDER(^OR(100.21,"AB",DFN_";DPT(",ORLIST))
if ORLIST'>0
QUIT
Begin DoDot:1
+3 IF $PIECE(^OR(100.21,ORLIST,0),U,2)'="TA"
QUIT
+4 ; type TA is a total autolinked list removal and addition, LEAVE the others ALONE
+5 SET DA=$ORDER(^OR(100.21,ORLIST,10,"B",DFN_";DPT(",0))
+6 SET DA(1)=ORLIST
SET DIK="^OR(100.21,"_DA(1)_",10,"
DO ^DIK
KILL DA,DIK
End DoDot:1
+7 ; Q:(TYPE=3) ;quit if discharge not working for ASIH. removed 11-94 mrh
UPDATE ; flow thru from DELPT - update autolists
+1 ; not a vaild movement
if 'VAIN(1)
QUIT
+2 ;ward
IF $GET(VAIN(4))
SET LINK=$PIECE(VAIN(4),"^")_";DIC(42,"
DO ADDPT
+3 SET RB=$GET(VAIN(5))
IF $DATA(RB)
IF RB'=""
SET EN=0
Begin DoDot:1
+4 SET EN=$ORDER(^DG(405.4,"B",RB,EN))
if EN'>0
QUIT
+5 ;room-bed
SET LINK=EN_";DG(405.4,"
DO ADDPT
End DoDot:1
+6 ;treating specialty
IF $GET(VAIN(3))
SET LINK=$PIECE(VAIN(3),"^")_";DIC(45.7,"
DO ADDPT
+7 ;primary provider
IF $GET(VAIN(2))
SET LINK=$PIECE(VAIN(2),"^")_";VA(200,"
DO ADDPT1("PB")
+8 ;attending dr
IF $GET(VAIN(11))
SET LINK=$PIECE(VAIN(11),"^")_";VA(200,"
DO ADDPT1("AB")
+9 QUIT
ADDPT ;called by UPDATE - add patient to autolists
+1 ; for WARD, ROOM-BED and TREATING SPECIALITY
+2 SET ORLIST=0
+3 FOR
SET ORLIST=$ORDER(^OR(100.21,"AC",LINK,ORLIST))
if ORLIST'>0
QUIT
Begin DoDot:1
+4 IF $PIECE(^OR(100.21,ORLIST,0),U,2)'["A"
QUIT
+5 ;list types TA and MRAL are auto add the others are manual
+6 ;quit if patient already on list
IF $DATA(^OR(100.21,ORLIST,10,"B",DFN_";DPT("))
QUIT
+7 IF '$DATA(^OR(100.21,ORLIST,10,0))
SET ^(0)="^100.2101AV^^"
+8 ;added DINUM in 247
KILL DIC,DA,DO,DD,DINUM
+9 SET DLAYGO=100.21
SET DA(1)=ORLIST
SET DIC="^OR(100.21,"_DA(1)_",10,"
SET DIC(0)="L"
SET X=DFN_";DPT("
+10 DO FILE^DICN
+11 ;added DINUM in 247
KILL DA,DD,DIC,DLAYGO,DO,X,DINUM
End DoDot:1
+12 QUIT
ADDPT1(LTYPE) ; called by UPDATE - add patient to autolists
+1 ; for primary attending or both (LTYPE)
+2 IF LTYPE']""
QUIT
+3 IF '+LINK
QUIT
+4 SET ORLIST=0
+5 FOR
SET ORLIST=$ORDER(^OR(100.21,"AC",LINK,ORLIST))
if ORLIST'>0
QUIT
Begin DoDot:1
+6 IF $PIECE(^OR(100.21,ORLIST,0),U,2)'["A"
QUIT
+7 ;quit if patient already on list
IF $DATA(^OR(100.21,ORLIST,10,"B",DFN_";DPT("))
QUIT
+8 SET PROV=0
FOR
SET PROV=$ORDER(^OR(100.21,ORLIST,2,"B",LINK,PROV))
if PROV'>0
QUIT
Begin DoDot:2
+9 IF LTYPE[$PIECE($GET(^OR(100.21,ORLIST,2,PROV,0)),U,2)
DO FILE
End DoDot:2
End DoDot:1
+10 QUIT
FILE ;
+1 IF '$DATA(^OR(100.21,ORLIST,10,0))
SET ^(0)="^100.2101AV^^"
+2 ;added DINUM in 247
KILL DIC,DA,DO,DD,DINUM
+3 SET DLAYGO=100.21
SET DA(1)=ORLIST
SET DIC="^OR(100.21,"_DA(1)_",10,"
SET DIC(0)="L"
SET X=DFN_";DPT("
+4 DO FILE^DICN
+5 ;added DINUM in 247
KILL DA,DD,DIC,DLAYGO,DO,X,DINUM
+6 QUIT
