| 1 | A1B2XFR ;ALB/MIR - SET STATUS TO DON'T SEND IF EDITED ; 14 JAN 91
|
|---|
| 2 | ;;Version 1.55 (local for MAS v5 sites);;
|
|---|
| 3 | ;
|
|---|
| 4 | ;A1B2TAG - Line tag to call
|
|---|
| 5 | ;
|
|---|
| 6 | ; call - PAT for updates to the ODS PATIENT file fields
|
|---|
| 7 | ; REG for updates to the ODS REGISTRATION file fields
|
|---|
| 8 | ; ADM for updates to the ODS ADMISSION or DISPLACED PATIENT
|
|---|
| 9 | ; file fields
|
|---|
| 10 | ; ADM1 for SPECIALTY update to ODS ADMISSION file
|
|---|
| 11 | ;
|
|---|
| 12 | ;
|
|---|
| 13 | N D0,D1,D2,DIV
|
|---|
| 14 | N I,OLD,X,Y
|
|---|
| 15 | D ON^A1B2UTL I A1B2ODS D @A1B2TAG
|
|---|
| 16 | K A1B2ODS,A1B2TAG Q
|
|---|
| 17 | ;
|
|---|
| 18 | ;
|
|---|
| 19 | PAT ; ODS PATIENT
|
|---|
| 20 | S X=$O(^A1B2(11500.1,"AD",DA,0)) I '$D(^A1B2(11500.1,+X,0)) Q
|
|---|
| 21 | S A1B2Y=11500.1 D UPD
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | ;
|
|---|
| 25 | REG ; ODS REGISTRATIONS
|
|---|
| 26 | S X=$S($D(^DPT(DA(1),"DIS",DA,"ODS")):+$P(^("ODS"),"^",2),1:"") I 'X Q
|
|---|
| 27 | I $D(^A1B2(11500.4,+X,0)) S A1B2Y=11500.4 D UPD
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | ;
|
|---|
| 31 | ADM ; ODS ADMISSIONS and DISPLACED PATIENTS
|
|---|
| 32 | S X=$S($D(^DGPM(DA,"ODS")):^("ODS"),1:"")
|
|---|
| 33 | I '$D(DGPMCA) S DGPMCA=$P(^DGPM(DA,0),"^",14)
|
|---|
| 34 | S X1=$S($D(^DGPM(DGPMCA,"ODS")):^("ODS"),1:"")
|
|---|
| 35 | I $D(^A1B2(11500.2,+$P(X1,"^",4),0)) S A1B2Y=11500.2,X=$P(X1,"^",4) D UPD Q
|
|---|
| 36 | I $D(^A1B2(11500.3,+$P(X,"^",7),0)) S A1B2Y=11500.3,X=$P(X,"^",7) D UPD
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | ADM1 ; ODS ADMISSIONS (for SPECIALTY)
|
|---|
| 40 | S X=$S($D(^DGPM(+$P(^DGPM(DA,0),"^",24),"ODS")):$P(^("ODS"),"^",4),1:"")
|
|---|
| 41 | I $D(^A1B2(11500.2,+X,0)) S A1B2Y=11500.2 D UPD
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | UPD ; update TRANSMISSION STATUS field to be 0...DON'T SEND, and re x-ref
|
|---|
| 45 | ;
|
|---|
| 46 | N DA S DA=+X
|
|---|
| 47 | S OLD=$S($D(^A1B2(A1B2Y,+X,1)):+^(1),1:0)
|
|---|
| 48 | F I=0:0 S I=$O(^DD(A1B2Y,1.01,1,I)) Q:'I I $D(^(I,0)),(^(0)'["TRIGGER") S X=OLD X ^DD(A1B2Y,1.01,1,I,2) S X=0 X ^DD(A1B2Y,1.01,1,I,1)
|
|---|
| 49 | S $P(^A1B2(A1B2Y,+DA,1),"^",1)=0
|
|---|
| 50 | Q
|
|---|
