- A1B2BGJ ;ALB/MIR - BACKGROUND JOB TO UPDATE A1B2 ENTRIES ; 14 JAN 91
- ;;Version 1.55 (local for MAS v5 sites);;
- ;
- F I=1:1:4 S A1B2FN=11500+(I/10) F J=0:0 S J=$O(^A1B2(A1B2FN,"AX",0,J)) Q:'J I $D(^A1B2(A1B2FN,J,0)) S DIE="^A1B2("_A1B2FN_",",DA=J,DR="" D @I:I'=3,2:I=3 D DIE:DR]""
- D ST^A1B2T1
- K XFR,I,J,A1B2FN D KILL^%ZTLOAD
- Q
- ;
- ;
- DIE ; new variables, call ^DIE
- N I,J,K D ^DIE
- Q
- ;
- ;
- 1 ;Update patients
- S DFN=$S($D(^A1B2(11500.1,+J,0)):$P(^(0),"^",12),1:"") Q:'DFN
- F K=0,.32,"ODS" S X(K)=$S($D(^DPT(DFN,K)):^(K),1:"")
- S DR=".01///"_$P(X(0),"^",9)_";.02////"_$P(X(0),"^",1)_";.03////"_$P(X(0),"^",3)_";.04///"_$S($P(X(.32),"^",5):"/"_$P(X(.32),"^",5),1:"@")_";.05///"_$S($P(X("ODS"),"^",3):"/"_$P(X("ODS"),"^",3),1:"@")
- S DR=DR_";.06///"_$S($P(X("ODS"),"^",2)]"":"/"_$P(X("ODS"),"^",2),1:"@")_";.07///"_$S('$D(^DPT(DFN,"DAC")):"",$P(^("DAC"),"^",1)]"":"/"_$P(^("DAC"),"^",1),1:"@")_";1.01////3"
- S ^A1B2(11500.1,J,.11)=$S($D(^DPT(DFN,.11)):^(.11),1:"") S X=^(.11),$P(^A1B2(11500.1,J,.11),"^",7)=$S($D(^DIC(5,+$P(X,"^",5),1,+$P(X,"^",7),0)):$P(^(0),"^",1),1:"")
- Q
- ;
- ;
- 2 ;Update admissions/discharges
- S XFR="AODS"_$S(I=2:"A",1:"D"),IFN=+$O(^DGPM(XFR,J,0)) I '$D(^DGPM(IFN,0)) Q
- F X=0,"ODS" S X(X)=$S($D(^DGPM(IFN,X)):^(X),1:"")
- I $P(X("ODS"),"^",7) D 3 Q
- S (X(1),X("ODS1"))=""
- I $P(X(0),U,17) S:$D(^DGPM($P(X(0),U,17),0)) X(1)=^(0) S:$D(^("ODS")) X("ODS1")=^("ODS")
- S DGSPEC=$O(^DGPM("APHY",IFN,0)),DGSPEC=$S($D(^DGPM(+DGSPEC,0)):$P(^(0),"^",9),1:""),DGSPEC=$S($D(^DIC(45.7,+DGSPEC,0)):$P(^(0),"^",2),1:"")
- S DR=".01///"_+X(0)_";.03////"_DGSPEC_";.05////"_$S($D(^DG(405.1,+$P(X(1),"^",4),0)):$P(^(0),"^",3),1:"")
- S DR=DR_";.06////"_$S(+X(1):+X(1),1:"")_";.1////"_$S($D(^DIC(4,+$P(X(1),"^",5),0)):$P(^(0),"^",1),1:"")_";.11////"_$P(X("ODS1"),"^",2)_";1.01////3"
- K DGSPEC Q
- ;
- ;
- 3 ;Update displace patients
- S DR=".01///"_+X(0)_";.03////"_$P(X("ODS"),"^",6)_";.1////"_$S($D(^DIC(4,+$P(X(0),"^",5),0)):$P(^(0),"^"),1:"")_";.11////"_$P(X("ODS"),"^",2)_";1.01////3"
- Q
- ;
- ;
- 4 ;get the DFN and multiple IFNs for registration option
- N DFN
- S DFN=$O(^DPT("AODSR",J,0)),IFN=$O(^(+DFN,0)) I IFN S DIE="^A1B2(11500.4," D REG
- K K Q
- ;
- ;
- REG ;Update registrations
- S X=$S($D(^DPT(DFN,"DIS",IFN,0)):^(0),1:"")
- S DR=".01///"_+X_";.05////"_$P(X,"^",7)_";1.01////3" N I,J,K D ^DIE
- Q
- ;
- ;
- QUEUE ; manually queue the ods background job
- S ZTRTN="A1B2BGJ",ZTDESC="ODS BACKGROUND JOB",ZTIO=""
- D ^%ZTLOAD
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1B2BGJ 2473 printed Apr 23, 2025@18:35:41 Page 2
- A1B2BGJ ;ALB/MIR - BACKGROUND JOB TO UPDATE A1B2 ENTRIES ; 14 JAN 91
- +1 ;;Version 1.55 (local for MAS v5 sites);;
- +2 ;
- +3 FOR I=1:1:4
- SET A1B2FN=11500+(I/10)
- FOR J=0:0
- SET J=$ORDER(^A1B2(A1B2FN,"AX",0,J))
- if 'J
- QUIT
- IF $DATA(^A1B2(A1B2FN,J,0))
- SET DIE="^A1B2("_A1B2FN_","
- SET DA=J
- SET DR=""
- if I'=3
- DO @I
- if I=3
- DO 2
- if DR]""
- DO DIE
- +4 DO ST^A1B2T1
- +5 KILL XFR,I,J,A1B2FN
- DO KILL^%ZTLOAD
- +6 QUIT
- +7 ;
- +8 ;
- DIE ; new variables, call ^DIE
- +1 NEW I,J,K
- DO ^DIE
- +2 QUIT
- +3 ;
- +4 ;
- 1 ;Update patients
- +1 SET DFN=$SELECT($DATA(^A1B2(11500.1,+J,0)):$PIECE(^(0),"^",12),1:"")
- if 'DFN
- QUIT
- +2 FOR K=0,.32,"ODS"
- SET X(K)=$SELECT($DATA(^DPT(DFN,K)):^(K),1:"")
- +3 SET DR=".01///"_$PIECE(X(0),"^",9)_";.02////"_$PIECE(X(0),"^",1)_";.03////"_$PIECE(X(0),"^",3)_";.04///"_$SELECT($PIECE(X(.32),"^",5):"/"_$PIECE(X(.32),"^",5),1:"@")_";.05///"_$SELECT($PIECE(X("ODS"),"^",3):"/"_$PIECE(X("ODS"),"^",3),1:"@")
- +4 SET DR=DR_";.06///"_$SELECT($PIECE(X("ODS"),"^",2)]"":"/"_$PIECE(X("ODS"),"^",2),1:"@")_";.07///"_$SELECT('$DATA(^DPT(DFN,"DAC")):"",$PIECE(^("DAC"),"^",1)]"":"/"_$PIECE(^("DAC"),"^",1),1:"@")_";1.01////3"
- +5 SET ^A1B2(11500.1,J,.11)=$SELECT($DATA(^DPT(DFN,.11)):^(.11),1:"")
- SET X=^(.11)
- SET $PIECE(^A1B2(11500.1,J,.11),"^",7)=$SELECT($DATA(^DIC(5,+$PIECE(X,"^",5),1,+$PIECE(X,"^",7),0)):$PIECE(^(0),"^",1),1:"")
- +6 QUIT
- +7 ;
- +8 ;
- 2 ;Update admissions/discharges
- +1 SET XFR="AODS"_$SELECT(I=2:"A",1:"D")
- SET IFN=+$ORDER(^DGPM(XFR,J,0))
- IF '$DATA(^DGPM(IFN,0))
- QUIT
- +2 FOR X=0,"ODS"
- SET X(X)=$SELECT($DATA(^DGPM(IFN,X)):^(X),1:"")
- +3 IF $PIECE(X("ODS"),"^",7)
- DO 3
- QUIT
- +4 SET (X(1),X("ODS1"))=""
- +5 IF $PIECE(X(0),U,17)
- if $DATA(^DGPM($PIECE(X(0),U,17),0))
- SET X(1)=^(0)
- if $DATA(^("ODS"))
- SET X("ODS1")=^("ODS")
- +6 SET DGSPEC=$ORDER(^DGPM("APHY",IFN,0))
- SET DGSPEC=$SELECT($DATA(^DGPM(+DGSPEC,0)):$PIECE(^(0),"^",9),1:"")
- SET DGSPEC=$SELECT($DATA(^DIC(45.7,+DGSPEC,0)):$PIECE(^(0),"^",2),1:"")
- +7 SET DR=".01///"_+X(0)_";.03////"_DGSPEC_";.05////"_$SELECT($DATA(^DG(405.1,+$PIECE(X(1),"^",4),0)):$PIECE(^(0),"^",3),1:"")
- +8 SET DR=DR_";.06////"_$SELECT(+X(1):+X(1),1:"")_";.1////"_$SELECT($DATA(^DIC(4,+$PIECE(X(1),"^",5),0)):$PIECE(^(0),"^",1),1:"")_";.11////"_$PIECE(X("ODS1"),"^",2)_";1.01////3"
- +9 KILL DGSPEC
- QUIT
- +10 ;
- +11 ;
- 3 ;Update displace patients
- +1 SET DR=".01///"_+X(0)_";.03////"_$PIECE(X("ODS"),"^",6)_";.1////"_$SELECT($DATA(^DIC(4,+$PIECE(X(0),"^",5),0)):$PIECE(^(0),"^"),1:"")_";.11////"_$PIECE(X("ODS"),"^",2)_";1.01////3"
- +2 QUIT
- +3 ;
- +4 ;
- 4 ;get the DFN and multiple IFNs for registration option
- +1 NEW DFN
- +2 SET DFN=$ORDER(^DPT("AODSR",J,0))
- SET IFN=$ORDER(^(+DFN,0))
- IF IFN
- SET DIE="^A1B2(11500.4,"
- DO REG
- +3 KILL K
- QUIT
- +4 ;
- +5 ;
- REG ;Update registrations
- +1 SET X=$SELECT($DATA(^DPT(DFN,"DIS",IFN,0)):^(0),1:"")
- +2 SET DR=".01///"_+X_";.05////"_$PIECE(X,"^",7)_";1.01////3"
- NEW I,J,K
- DO ^DIE
- +3 QUIT
- +4 ;
- +5 ;
- QUEUE ; manually queue the ods background job
- +1 SET ZTRTN="A1B2BGJ"
- SET ZTDESC="ODS BACKGROUND JOB"
- SET ZTIO=""
- +2 DO ^%ZTLOAD
- +3 QUIT
