[613] | 1 | ORLPAUT0 ; slc/CLA - Automatically load patients into lists ;2/12/92
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**247**;Dec 17, 1997
|
---|
| 3 | Q
|
---|
| 4 | EN ;called by protocol ORU AUTOLIST - automatically update lists with AUTOLINK set.
|
---|
| 5 | Q:'$D(DGPMT)!('$D(DFN)) S TYPE=DGPMT
|
---|
| 6 | W !!,"Updating automated team lists..."
|
---|
| 7 | 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)
|
---|
| 8 | D DELPT
|
---|
| 9 | W "completed."
|
---|
| 10 | EXIT K DIK,EN,LINK,ORLIST,PROV,RB,TYPE,VA200
|
---|
| 11 | Q
|
---|
| 12 | DELPT ;called by EN - remove patient from autolists
|
---|
| 13 | S ORLIST=0
|
---|
| 14 | F S ORLIST=$O(^OR(100.21,"AB",DFN_";DPT(",ORLIST)) Q:ORLIST'>0 D
|
---|
| 15 | . I $P(^OR(100.21,ORLIST,0),U,2)'="TA" Q
|
---|
| 16 | . ; type TA is a total autolinked list removal and addition, LEAVE the others ALONE
|
---|
| 17 | . S DA=$O(^OR(100.21,ORLIST,10,"B",DFN_";DPT(",0))
|
---|
| 18 | . S DA(1)=ORLIST,DIK="^OR(100.21,"_DA(1)_",10," D ^DIK K DA,DIK
|
---|
| 19 | ; Q:(TYPE=3) ;quit if discharge not working for ASIH. removed 11-94 mrh
|
---|
| 20 | UPDATE ; flow thru from DELPT - update autolists
|
---|
| 21 | Q:'VAIN(1) ; not a vaild movement
|
---|
| 22 | I $G(VAIN(4)) S LINK=$P(VAIN(4),"^")_";DIC(42," D ADDPT ;ward
|
---|
| 23 | S RB=$G(VAIN(5)) I $D(RB),RB'="" S EN=0 D
|
---|
| 24 | .S EN=$O(^DG(405.4,"B",RB,EN)) Q:EN'>0
|
---|
| 25 | .S LINK=EN_";DG(405.4," D ADDPT ;room-bed
|
---|
| 26 | I $G(VAIN(3)) S LINK=$P(VAIN(3),"^")_";DIC(45.7," D ADDPT ;treating specialty
|
---|
| 27 | I $G(VAIN(2)) S LINK=$P(VAIN(2),"^")_";VA(200," D ADDPT1("PB") ;primary provider
|
---|
| 28 | I $G(VAIN(11)) S LINK=$P(VAIN(11),"^")_";VA(200," D ADDPT1("AB") ;attending dr
|
---|
| 29 | Q
|
---|
| 30 | ADDPT ;called by UPDATE - add patient to autolists
|
---|
| 31 | ; for WARD, ROOM-BED and TREATING SPECIALITY
|
---|
| 32 | S ORLIST=0
|
---|
| 33 | F S ORLIST=$O(^OR(100.21,"AC",LINK,ORLIST)) Q:ORLIST'>0 D
|
---|
| 34 | . I $P(^OR(100.21,ORLIST,0),U,2)'["A" Q
|
---|
| 35 | . ;list types TA and MRAL are auto add the others are manual
|
---|
| 36 | . I $D(^OR(100.21,ORLIST,10,"B",DFN_";DPT(")) Q ;quit if patient already on list
|
---|
| 37 | . I '$D(^OR(100.21,ORLIST,10,0)) S ^(0)="^100.2101AV^^"
|
---|
| 38 | . K DIC,DA,DO,DD,DINUM ;added DINUM in 247
|
---|
| 39 | . S DLAYGO=100.21,DA(1)=ORLIST,DIC="^OR(100.21,"_DA(1)_",10,",DIC(0)="L",X=DFN_";DPT("
|
---|
| 40 | . D FILE^DICN
|
---|
| 41 | . K DA,DD,DIC,DLAYGO,DO,X,DINUM ;added DINUM in 247
|
---|
| 42 | Q
|
---|
| 43 | ADDPT1(LTYPE) ; called by UPDATE - add patient to autolists
|
---|
| 44 | ; for primary attending or both (LTYPE)
|
---|
| 45 | I LTYPE']"" Q
|
---|
| 46 | I '+LINK Q
|
---|
| 47 | S ORLIST=0
|
---|
| 48 | F S ORLIST=$O(^OR(100.21,"AC",LINK,ORLIST)) Q:ORLIST'>0 D
|
---|
| 49 | . I $P(^OR(100.21,ORLIST,0),U,2)'["A" Q
|
---|
| 50 | . I $D(^OR(100.21,ORLIST,10,"B",DFN_";DPT(")) Q ;quit if patient already on list
|
---|
| 51 | . S PROV=0 F S PROV=$O(^OR(100.21,ORLIST,2,"B",LINK,PROV)) Q:PROV'>0 D
|
---|
| 52 | .. I LTYPE[$P($G(^OR(100.21,ORLIST,2,PROV,0)),U,2) D FILE
|
---|
| 53 | Q
|
---|
| 54 | FILE ;
|
---|
| 55 | I '$D(^OR(100.21,ORLIST,10,0)) S ^(0)="^100.2101AV^^"
|
---|
| 56 | K DIC,DA,DO,DD,DINUM ;added DINUM in 247
|
---|
| 57 | S DLAYGO=100.21,DA(1)=ORLIST,DIC="^OR(100.21,"_DA(1)_",10,",DIC(0)="L",X=DFN_";DPT("
|
---|
| 58 | D FILE^DICN
|
---|
| 59 | K DA,DD,DIC,DLAYGO,DO,X,DINUM ;added DINUM in 247
|
---|
| 60 | Q
|
---|