source: WorldVistAEHR/trunk/r/OPERATIONS_WITH_DESERT_STORM-A1B2/A1B2XFR.m@ 701

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

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1A1B2XFR ;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 ;
19PAT ; 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 ;
25REG ; 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 ;
31ADM ; 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 ;
39ADM1 ; 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 ;
44UPD ; 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
Note: See TracBrowser for help on using the repository browser.