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 Nov 22, 2024@17:31:14 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
