source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLPAUT0.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1ORLPAUT0 ; slc/CLA - Automatically load patients into lists ;2/12/92
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**247**;Dec 17, 1997
3 Q
4EN ;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."
10EXIT K DIK,EN,LINK,ORLIST,PROV,RB,TYPE,VA200
11 Q
12DELPT ;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
20UPDATE ; 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
30ADDPT ;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
43ADDPT1(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
54FILE ;
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
Note: See TracBrowser for help on using the repository browser.