- 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 Mar 13, 2025@21:36:26 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
