- 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 Jan 18, 2025@03:22:42 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