| 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
 | 
|---|