A1B2XFR ;ALB/MIR - SET STATUS TO DON'T SEND IF EDITED ; 14 JAN 91
;;Version 1.55 (local for MAS v5 sites);;
;
;A1B2TAG - Line tag to call
;
; call - PAT for updates to the ODS PATIENT file fields
; REG for updates to the ODS REGISTRATION file fields
; ADM for updates to the ODS ADMISSION or DISPLACED PATIENT
; file fields
; ADM1 for SPECIALTY update to ODS ADMISSION file
;
;
N D0,D1,D2,DIV
N I,OLD,X,Y
D ON^A1B2UTL I A1B2ODS D @A1B2TAG
K A1B2ODS,A1B2TAG Q
;
;
PAT ; ODS PATIENT
S X=$O(^A1B2(11500.1,"AD",DA,0)) I '$D(^A1B2(11500.1,+X,0)) Q
S A1B2Y=11500.1 D UPD
Q
;
;
REG ; ODS REGISTRATIONS
S X=$S($D(^DPT(DA(1),"DIS",DA,"ODS")):+$P(^("ODS"),"^",2),1:"") I 'X Q
I $D(^A1B2(11500.4,+X,0)) S A1B2Y=11500.4 D UPD
Q
;
;
ADM ; ODS ADMISSIONS and DISPLACED PATIENTS
S X=$S($D(^DGPM(DA,"ODS")):^("ODS"),1:"")
I '$D(DGPMCA) S DGPMCA=$P(^DGPM(DA,0),"^",14)
S X1=$S($D(^DGPM(DGPMCA,"ODS")):^("ODS"),1:"")
I $D(^A1B2(11500.2,+$P(X1,"^",4),0)) S A1B2Y=11500.2,X=$P(X1,"^",4) D UPD Q
I $D(^A1B2(11500.3,+$P(X,"^",7),0)) S A1B2Y=11500.3,X=$P(X,"^",7) D UPD
Q
;
ADM1 ; ODS ADMISSIONS (for SPECIALTY)
S X=$S($D(^DGPM(+$P(^DGPM(DA,0),"^",24),"ODS")):$P(^("ODS"),"^",4),1:"")
I $D(^A1B2(11500.2,+X,0)) S A1B2Y=11500.2 D UPD
Q
;
UPD ; update TRANSMISSION STATUS field to be 0...DON'T SEND, and re x-ref
;
N DA S DA=+X
S OLD=$S($D(^A1B2(A1B2Y,+X,1)):+^(1),1:0)
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)
S $P(^A1B2(A1B2Y,+DA,1),"^",1)=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1B2XFR 1655 printed Oct 16, 2024@18:22:15 Page 2
A1B2XFR ;ALB/MIR - SET STATUS TO DON'T SEND IF EDITED ; 14 JAN 91
+1 ;;Version 1.55 (local for MAS v5 sites);;
+2 ;
+3 ;A1B2TAG - Line tag to call
+4 ;
+5 ; call - PAT for updates to the ODS PATIENT file fields
+6 ; REG for updates to the ODS REGISTRATION file fields
+7 ; ADM for updates to the ODS ADMISSION or DISPLACED PATIENT
+8 ; file fields
+9 ; ADM1 for SPECIALTY update to ODS ADMISSION file
+10 ;
+11 ;
+12 NEW D0,D1,D2,DIV
+13 NEW I,OLD,X,Y
+14 DO ON^A1B2UTL
IF A1B2ODS
DO @A1B2TAG
+15 KILL A1B2ODS,A1B2TAG
QUIT
+16 ;
+17 ;
PAT ; ODS PATIENT
+1 SET X=$ORDER(^A1B2(11500.1,"AD",DA,0))
IF '$DATA(^A1B2(11500.1,+X,0))
QUIT
+2 SET A1B2Y=11500.1
DO UPD
+3 QUIT
+4 ;
+5 ;
REG ; ODS REGISTRATIONS
+1 SET X=$SELECT($DATA(^DPT(DA(1),"DIS",DA,"ODS")):+$PIECE(^("ODS"),"^",2),1:"")
IF 'X
QUIT
+2 IF $DATA(^A1B2(11500.4,+X,0))
SET A1B2Y=11500.4
DO UPD
+3 QUIT
+4 ;
+5 ;
ADM ; ODS ADMISSIONS and DISPLACED PATIENTS
+1 SET X=$SELECT($DATA(^DGPM(DA,"ODS")):^("ODS"),1:"")
+2 IF '$DATA(DGPMCA)
SET DGPMCA=$PIECE(^DGPM(DA,0),"^",14)
+3 SET X1=$SELECT($DATA(^DGPM(DGPMCA,"ODS")):^("ODS"),1:"")
+4 IF $DATA(^A1B2(11500.2,+$PIECE(X1,"^",4),0))
SET A1B2Y=11500.2
SET X=$PIECE(X1,"^",4)
DO UPD
QUIT
+5 IF $DATA(^A1B2(11500.3,+$PIECE(X,"^",7),0))
SET A1B2Y=11500.3
SET X=$PIECE(X,"^",7)
DO UPD
+6 QUIT
+7 ;
ADM1 ; ODS ADMISSIONS (for SPECIALTY)
+1 SET X=$SELECT($DATA(^DGPM(+$PIECE(^DGPM(DA,0),"^",24),"ODS")):$PIECE(^("ODS"),"^",4),1:"")
+2 IF $DATA(^A1B2(11500.2,+X,0))
SET A1B2Y=11500.2
DO UPD
+3 QUIT
+4 ;
UPD ; update TRANSMISSION STATUS field to be 0...DON'T SEND, and re x-ref
+1 ;
+2 NEW DA
SET DA=+X
+3 SET OLD=$SELECT($DATA(^A1B2(A1B2Y,+X,1)):+^(1),1:0)
+4 FOR I=0:0
SET I=$ORDER(^DD(A1B2Y,1.01,1,I))
if 'I
QUIT
IF $DATA(^(I,0))
IF (^(0)'["TRIGGER")
SET X=OLD
XECUTE ^DD(A1B2Y,1.01,1,I,2)
SET X=0
XECUTE ^DD(A1B2Y,1.01,1,I,1)
+5 SET $PIECE(^A1B2(A1B2Y,+DA,1),"^",1)=0
+6 QUIT
