BPCIMDSP ; IHS/OIT/MJL - IMMUN HISTORY DISP GUI RPC ROUTINE ;
;;1.5;BPC;;MAY 26, 2005
;
GETIHDSP(BGUARRAY,BPCPIEN) ;EP CALL FROM REMOTE PROC: BPC GET IMM HISTORY DATA
;
ENH ;
;Return array format
; 1=visit date
; 2=dose-vac or skin test name
; 3=imm reaction
; 4=skin result
; 5=location
; 6=skin reading
; 7=skin reading date fm format
; 8=imm or skin long name
; 9=imm or skin IEN
; 10=visit IEN
; 11=I or S for type
; 12=V File IEN
; 13=encounter provider
; 14=Visit date in fm format
S BPCGUI=1,X="",XWBWRAP=1 K ^TMP($J)
S BGUARRAY="^TMP("_$J_")"
;S BPCPIEN=25241,DUZ=1 ;TESTING
I $P($G(^BISITE(DUZ(2),0)),U,15)\1'=7 S ^TMP($J,1)=-1,^TMP($J,2)="IMMUNIZATION VERSION INCORRECT!" D KILL Q
I $G(BPCPIEN)="" S ^TMP($J,1)=-1,^TMP($J,2)="PATIENT IEN NOT SENT!" D KILL Q
S X="BILOGO",BPCBIOS="" X ^%ZOSF("TEST") I $T S BPCX=$$VER^BILOGO I BPCX["8." S BPCBIOS=1 ;FJE
D IMMHX^BIRPC(.X,BPCPIEN)
FJ S BPCCTR=1
S X1="" F J=1:1 S X1=$P(X,U,J) Q:'$L(X1)!($A($E(X1,1))=31)!(X1["NO RECORDS") D
. S BPCCTR=BPCCTR+1
. F I=1:1:15 S X(I)=$P(X1,"|",I)
. S ^TMP($J,BPCCTR)=X(7)
. F K=3,13,8,5,9,10 S ^TMP($J,BPCCTR)=^TMP($J,BPCCTR)_U_X(K)
. S $P(^TMP($J,BPCCTR),U,11)=X(1),$P(^TMP($J,BPCCTR),U,12)=X(4)
. I +X(15) S $P(^TMP($J,BPCCTR),U,13)=$P($G(^VA(200,X(15),0)),U,1)
. I X(1)="I" D
.. S X(16)="",X(16)=$O(^AUTTIMM("D",X(2),X(16))) I +X(16) S X(17)=$P($G(^AUTTIMM(X(16),0)),U,1),$P(^TMP($J,BPCCTR),U,8)=X(17)
.. S Y=$P($G(^AUPNVIMM(X(4),0)),U,1),$P(^TMP($J,BPCCTR),U,9)=+Y
.. S Y=$P($G(^AUPNVIMM(X(4),0)),U,3),$P(^TMP($J,BPCCTR),U,10)=+Y
.. S Y=$P($G(^AUPNVSIT(+Y,0)),U,1),$P(^TMP($J,BPCCTR),U,14)=Y
.. I BPCBIOS S $P(^TMP($J,BPCCTR),U,2)=X(2) ;FJE
. I X(1)="S" D
.. S $P(^TMP($J,BPCCTR),U,2)=X(11)
.. I +X(12) S Y=$P($G(^AUTTSK(X(12),0)),U,1),$P(^TMP($J,BPCCTR),U,8)=Y
.. S Y=$P($G(^AUPNVSK(X(4),0)),U,1),$P(^TMP($J,BPCCTR),U,9)=+Y
.. S Y=$P($G(^AUPNVSK(X(4),0)),U,3),$P(^TMP($J,BPCCTR),U,10)=+Y
.. S Y=$P($G(^AUPNVSIT(+Y,0)),U,1),$P(^TMP($J,BPCCTR),U,14)=Y
D CONTRAS^BIRPC5(.X,BPCPIEN)
S X1="" F J=1:1 S X1=$P(X,U,J) Q:'$L(X1)!($A($E(X1,1))=31)!(X1["NO RECORDS") D
. S BPCCTR=BPCCTR+1
. F I=1:1:4 S X(I)=$P(X1,"|",I)
. S ^TMP($J,BPCCTR)=X(4)_U_X(2)_U_"Contraindication"_U_X(3)
. S $P(^TMP($J,BPCCTR),U,11)="C"
I BPCCTR=1 S ^TMP($J,1)="1",^TMP($J,2)="No Data Available" D KILL Q
S ^TMP($J,1)=BPCCTR
D KILL
Q
GETIFDSP(BGUARRAY,BPCPIEN) ;EP CALL FROM REMOTE PROC: BPC GET IMM FORECAST DATA
;
ENF ;
S BPCGUI=1,XWBWRAP=1 K ^TMP($J)
S BGUARRAY="^TMP("_$J_")"
I $P($G(^BISITE(DUZ(2),0)),U,15)\1'=7 S ^TMP($J,1)=-1,^TMP($J,2)="IMMUNIZATION VERSION INCORRECT!" D KILL Q
;S BPCPIEN=25241,DUZ=1,DUZ(0)=4585 TESTING D ENF^BPCIMDSP
;S BPCPIEN=1,DUZ=1,DUZ(0)=4585
I $G(BPCPIEN)="" S ^TMP($J,1)=-1,^TMP($J,2)="PATIENT IEN NOT SENT!" D KILL Q
K X S X=""
D IMMFORC^BIRPC(.X,BPCPIEN)
I X["Forecasting disabled" S ^TMP($J,1)="1",^TMP($J,2)=$P(X,$C(31),3) D KILL Q
I X["Forecasting disabled" S ^TMP($J,1)="1",^TMP($J,2)=$P(X,".") D KILL Q
;I X["No immunizations due" S ^TMP($J,1)="1",^TMP($J,2)=$P(X,$C(31),3) D KILL Q
I X["No immunizations due" S ^TMP($J,1)="1",^TMP($J,2)=$P(X,".") D KILL Q
S BPCCTR=1
S X1=0 F I=1:1 S X1=$P(X,U,I) Q:$A($E(X1,2))=31 D
. S BPCCTR=BPCCTR+1
. S X2=$P(X1,"|",1),X6=$E(X2,3,99)
. S X3=$P(X1,"|",2),X4=$P(X1,"|",3)
. S X7="",X7=$O(^AUTTIMM("D",X6,X7))
. S X5="" I +X7 S X5=$G(^AUTTIMM(X7,0)),X5=$P(X5,U,1)
. S X8=+X2 S:X8=0 X8=""
. S ^TMP($J,BPCCTR)=X2_U_X3_U_X4_U_X5_U_X8_U_X7
I BPCCTR=1 S ^TMP($J,1)="1",^TMP($J,2)="No Data Available" D KILL Q
S ^TMP($J,1)=BPCCTR
D KILL
Q
TESTF ;TESTS FOR SEVERAL PATIENTS
S XX=0 F S XX=$O(^DPT(XX)) Q:+XX=0 D
. S BPCPIEN=XX,DUZ=1,DUZ(2)=4585
. D ENF
. W !,X
Q
TESTH ;TESTS FOR SEVERAL PATIENTS
S XX=0 F S XX=$O(^DPT(XX)) Q:+XX=0 D
. S BPCPIEN=XX,DUZ=1,DUZ(2)=4585
. D ENH
. W !,X
Q
TESTL ;TESTS FOR SEVERAL LOTS
S U="^" D VAC
;S XX=1 F S XX=$O(^TMP($J,XX)) Q:+XX=0 D
F I=106,107,113,115,117 S BPCVIEN=I D
. ;S BPCVIEN=$P($G(^TMP($J,XX)),U,3) W !,^TMP($J,XX)
. W !,BPCVIEN
. D LOT
. W !,^BITMP($J),I
Q
VACNAMS(BGUARRAY) ;EP CALL FROM REMOTE PROC: MDAO
;
VAC ;
S BPCGUI=1,X="" K ^TMP($J)
S BGUARRAY="^TMP("_$J_")"
I $P($G(^BISITE(DUZ(2),0)),U,15)\1'=7 S ^TMP($J,1)=-1,^TMP($J,2)="IMMUNIZATION VERSION INCORRECT!" D KILL Q
D VACNAMS^BIRPC2(.X)
S BPCCTR=1
S X="" F S X=$O(^BITMP($J,"DILIST",1,X)) Q:+X=0 D
. S BPCCTR=BPCCTR+1
. S ^TMP($J,BPCCTR)=^BITMP($J,"DILIST",1,X)
. S ^TMP($J,BPCCTR)=^TMP($J,BPCCTR)_U_$G(^BITMP($J,"DILIST","ID",X,.02))
. S ^TMP($J,BPCCTR)=^TMP($J,BPCCTR)_U_^BITMP($J,"DILIST",2,X)
I BPCCTR=1 S ^TMP($J,1)=-1,^TMP($J,2)="No Vaccine list is available" D KILL Q
S ^TMP($J,1)=BPCCTR
D KILL
Q
LOTNUMS(BGUARRAY,BPCVIEN) ;EP CALL FROM REMOTE PROC: MDAO
LOT ;
S BPCGUI=1,X="" K ^TMP($J)
S BGUARRAY="^TMP("_$J_")"
I $P($G(^BISITE(DUZ(2),0)),U,15)\1'=7 S ^TMP($J,1)=-1,^TMP($J,2)="IMMUNIZATION VERSION INCORRECT!" D KILL Q
I $G(BPCVIEN)="" S ^TMP($J,1)=-1,^TMP($J,2)="VACCINE IEN NOT SENT!" D KILL Q
D LOTNUMS^BIRPC2(X,BPCVIEN)
Q
S BPCCTR=1
S X="" F S X=$O(^BITMP($J,"DILIST",1,X)) Q:+X=0 D
. S BPCCTR=BPCCTR+1
. S ^TMP($J,BPCCTR)=^BITMP($J,"DILIST",1,X)
. S ^TMP($J,BPCCTR)=^TMP($J,BPCCTR)_U_$G(^BITMP($J,"DILIST","ID",X,.02))
. S ^TMP($J,BPCCTR)=^TMP($J,BPCCTR)_U_^BITMP($J,"DILIST",2,X)
I BPCCTR=1 S ^TMP($J,1)=-1,^TMP($J,2)="No Vaccine list is available" D KILL Q
S ^TMP($J,1)=BPCCTR
D KILL
Q
USELOT(BGUARRAY,BPCLIEN) ;EP CALL FROM REMOTE PROC: BPC IMM LOT REQUIRED
;
ENL ;
S BPCGUI=1,XWBWRAP=1,X="" K ^TMP($J)
S BGUARRAY="^TMP("_$J_")"
S BPCLIEN=107,DUZ=1 ;TESTING
I $P($G(^BISITE(DUZ(2),0)),U,15)\1'=7 S ^TMP($J,1)=-1,^TMP($J,2)="IMMUNIZATION VERSION INCORRECT!" D KILL Q
I $G(BPCLIEN)="" S ^TMP($J,1)=-1,^TMP($J,2)="VACCINE IEN NOT SENT!" D KILL Q
S BPCCTR=1
S X1="",X1=$O(^AUTTIML("C",BPCLIEN,X1)) Q:X1="" D
. S BPCCTR=BPCCTR+1
. S ^TMP($J,BPCCTR)=X1
I BPCCTR=1 S ^TMP($J,1)="1",^TMP($J,2)=0 Q
I BPCCTR=2 S ^TMP($J,1)="1",^TMP($J,2)=1
D KILL
Q
;
HIDOSE(BGUARRAY,BPCPIEN,BPCVIEN) ;EP CALL FROM REMOTE PROC: BPC IMM HIDOSE
;
ENDOSE ;
S BPCGUI=1,XWBWRAP=1,X="" K ^TMP($J)
S BGUARRAY="^TMP("_$J_")"
S BPCPIEN=25241,BPCVIEN=133,DUZ=1 ;TESTING
I $G(BPCPIEN)="" S ^TMP($J,1)=-1,^TMP($J,2)="PATIENT IEN NOT SENT!" D KILL Q
I $G(BPCVIEN)="" S ^TMP($J,1)=-1,^TMP($J,2)="VACCINE IEN NOT SENT!" D KILL Q
S (X,X1)="" D IMMHX^BIRPC(.X,25241)
S X1=$$HIDOSE^BIUTL11(25241,133,.X)
S ^TMP($J,1)="1",^TMP($J,2)=""
S:+X1 ^TMP($J,2)=+X1
D KILL
Q
;
KILL ;
K BPCCTR,BPCGUI,BPCLIEN,BPCPIEN,BPCVIEN,X,X1,X2,X3,X4,X5,X6,X7,X8,XX
Q
BPCIMDSP ; IHS/OIT/MJL - IMMUN HISTORY DISP GUI RPC ROUTINE ;
+1 ;;1.5;BPC;;MAY 26, 2005
+2 ;
GETIHDSP(BGUARRAY,BPCPIEN) ;EP CALL FROM REMOTE PROC: BPC GET IMM HISTORY DATA
+1 ;
ENH ;
+1 ;Return array format
+2 ; 1=visit date
+3 ; 2=dose-vac or skin test name
+4 ; 3=imm reaction
+5 ; 4=skin result
+6 ; 5=location
+7 ; 6=skin reading
+8 ; 7=skin reading date fm format
+9 ; 8=imm or skin long name
+10 ; 9=imm or skin IEN
+11 ; 10=visit IEN
+12 ; 11=I or S for type
+13 ; 12=V File IEN
+14 ; 13=encounter provider
+15 ; 14=Visit date in fm format
+16 SET BPCGUI=1
SET X=""
SET XWBWRAP=1
KILL ^TMP($JOB)
+17 SET BGUARRAY="^TMP("_$JOB_")"
+18 ;S BPCPIEN=25241,DUZ=1 ;TESTING
+19 IF $PIECE($GET(^BISITE(DUZ(2),0)),U,15)\1'=7
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="IMMUNIZATION VERSION INCORRECT!"
DO KILL
QUIT
+20 IF $GET(BPCPIEN)=""
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="PATIENT IEN NOT SENT!"
DO KILL
QUIT
+21 ;FJE
SET X="BILOGO"
SET BPCBIOS=""
XECUTE ^%ZOSF("TEST")
IF $TEST
SET BPCX=$$VER^BILOGO
IF BPCX["8."
SET BPCBIOS=1
+22 DO IMMHX^BIRPC(.X,BPCPIEN)
FJ SET BPCCTR=1
+1 SET X1=""
FOR J=1:1
SET X1=$PIECE(X,U,J)
IF '$LENGTH(X1)!($ASCII($EXTRACT(X1,1))=31)!(X1["NO RECORDS")
QUIT
Begin DoDot:1
+2 SET BPCCTR=BPCCTR+1
+3 FOR I=1:1:15
SET X(I)=$PIECE(X1,"|",I)
+4 SET ^TMP($JOB,BPCCTR)=X(7)
+5 FOR K=3,13,8,5,9,10
SET ^TMP($JOB,BPCCTR)=^TMP($JOB,BPCCTR)_U_X(K)
+6 SET $PIECE(^TMP($JOB,BPCCTR),U,11)=X(1)
SET $PIECE(^TMP($JOB,BPCCTR),U,12)=X(4)
+7 IF +X(15)
SET $PIECE(^TMP($JOB,BPCCTR),U,13)=$PIECE($GET(^VA(200,X(15),0)),U,1)
+8 IF X(1)="I"
Begin DoDot:2
+9 SET X(16)=""
SET X(16)=$ORDER(^AUTTIMM("D",X(2),X(16)))
IF +X(16)
SET X(17)=$PIECE($GET(^AUTTIMM(X(16),0)),U,1)
SET $PIECE(^TMP($JOB,BPCCTR),U,8)=X(17)
+10 SET Y=$PIECE($GET(^AUPNVIMM(X(4),0)),U,1)
SET $PIECE(^TMP($JOB,BPCCTR),U,9)=+Y
+11 SET Y=$PIECE($GET(^AUPNVIMM(X(4),0)),U,3)
SET $PIECE(^TMP($JOB,BPCCTR),U,10)=+Y
+12 SET Y=$PIECE($GET(^AUPNVSIT(+Y,0)),U,1)
SET $PIECE(^TMP($JOB,BPCCTR),U,14)=Y
+13 ;FJE
IF BPCBIOS
SET $PIECE(^TMP($JOB,BPCCTR),U,2)=X(2)
End DoDot:2
+14 IF X(1)="S"
Begin DoDot:2
+15 SET $PIECE(^TMP($JOB,BPCCTR),U,2)=X(11)
+16 IF +X(12)
SET Y=$PIECE($GET(^AUTTSK(X(12),0)),U,1)
SET $PIECE(^TMP($JOB,BPCCTR),U,8)=Y
+17 SET Y=$PIECE($GET(^AUPNVSK(X(4),0)),U,1)
SET $PIECE(^TMP($JOB,BPCCTR),U,9)=+Y
+18 SET Y=$PIECE($GET(^AUPNVSK(X(4),0)),U,3)
SET $PIECE(^TMP($JOB,BPCCTR),U,10)=+Y
+19 SET Y=$PIECE($GET(^AUPNVSIT(+Y,0)),U,1)
SET $PIECE(^TMP($JOB,BPCCTR),U,14)=Y
End DoDot:2
End DoDot:1
+20 DO CONTRAS^BIRPC5(.X,BPCPIEN)
+21 SET X1=""
FOR J=1:1
SET X1=$PIECE(X,U,J)
IF '$LENGTH(X1)!($ASCII($EXTRACT(X1,1))=31)!(X1["NO RECORDS")
QUIT
Begin DoDot:1
+22 SET BPCCTR=BPCCTR+1
+23 FOR I=1:1:4
SET X(I)=$PIECE(X1,"|",I)
+24 SET ^TMP($JOB,BPCCTR)=X(4)_U_X(2)_U_"Contraindication"_U_X(3)
+25 SET $PIECE(^TMP($JOB,BPCCTR),U,11)="C"
End DoDot:1
+26 IF BPCCTR=1
SET ^TMP($JOB,1)="1"
SET ^TMP($JOB,2)="No Data Available"
DO KILL
QUIT
+27 SET ^TMP($JOB,1)=BPCCTR
+28 DO KILL
+29 QUIT
GETIFDSP(BGUARRAY,BPCPIEN) ;EP CALL FROM REMOTE PROC: BPC GET IMM FORECAST DATA
+1 ;
ENF ;
+1 SET BPCGUI=1
SET XWBWRAP=1
KILL ^TMP($JOB)
+2 SET BGUARRAY="^TMP("_$JOB_")"
+3 IF $PIECE($GET(^BISITE(DUZ(2),0)),U,15)\1'=7
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="IMMUNIZATION VERSION INCORRECT!"
DO KILL
QUIT
+4 ;S BPCPIEN=25241,DUZ=1,DUZ(0)=4585 TESTING D ENF^BPCIMDSP
+5 ;S BPCPIEN=1,DUZ=1,DUZ(0)=4585
+6 IF $GET(BPCPIEN)=""
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="PATIENT IEN NOT SENT!"
DO KILL
QUIT
+7 KILL X
SET X=""
+8 DO IMMFORC^BIRPC(.X,BPCPIEN)
+9 IF X["Forecasting disabled"
SET ^TMP($JOB,1)="1"
SET ^TMP($JOB,2)=$PIECE(X,$CHAR(31),3)
DO KILL
QUIT
+10 IF X["Forecasting disabled"
SET ^TMP($JOB,1)="1"
SET ^TMP($JOB,2)=$PIECE(X,".")
DO KILL
QUIT
+11 ;I X["No immunizations due" S ^TMP($J,1)="1",^TMP($J,2)=$P(X,$C(31),3) D KILL Q
+12 IF X["No immunizations due"
SET ^TMP($JOB,1)="1"
SET ^TMP($JOB,2)=$PIECE(X,".")
DO KILL
QUIT
+13 SET BPCCTR=1
+14 SET X1=0
FOR I=1:1
SET X1=$PIECE(X,U,I)
IF $ASCII($EXTRACT(X1,2))=31
QUIT
Begin DoDot:1
+15 SET BPCCTR=BPCCTR+1
+16 SET X2=$PIECE(X1,"|",1)
SET X6=$EXTRACT(X2,3,99)
+17 SET X3=$PIECE(X1,"|",2)
SET X4=$PIECE(X1,"|",3)
+18 SET X7=""
SET X7=$ORDER(^AUTTIMM("D",X6,X7))
+19 SET X5=""
IF +X7
SET X5=$GET(^AUTTIMM(X7,0))
SET X5=$PIECE(X5,U,1)
+20 SET X8=+X2
IF X8=0
SET X8=""
+21 SET ^TMP($JOB,BPCCTR)=X2_U_X3_U_X4_U_X5_U_X8_U_X7
End DoDot:1
+22 IF BPCCTR=1
SET ^TMP($JOB,1)="1"
SET ^TMP($JOB,2)="No Data Available"
DO KILL
QUIT
+23 SET ^TMP($JOB,1)=BPCCTR
+24 DO KILL
+25 QUIT
TESTF ;TESTS FOR SEVERAL PATIENTS
+1 SET XX=0
FOR
SET XX=$ORDER(^DPT(XX))
IF +XX=0
QUIT
Begin DoDot:1
+2 SET BPCPIEN=XX
SET DUZ=1
SET DUZ(2)=4585
+3 DO ENF
+4 WRITE !,X
End DoDot:1
+5 QUIT
TESTH ;TESTS FOR SEVERAL PATIENTS
+1 SET XX=0
FOR
SET XX=$ORDER(^DPT(XX))
IF +XX=0
QUIT
Begin DoDot:1
+2 SET BPCPIEN=XX
SET DUZ=1
SET DUZ(2)=4585
+3 DO ENH
+4 WRITE !,X
End DoDot:1
+5 QUIT
TESTL ;TESTS FOR SEVERAL LOTS
+1 SET U="^"
DO VAC
+2 ;S XX=1 F S XX=$O(^TMP($J,XX)) Q:+XX=0 D
+3 FOR I=106,107,113,115,117
SET BPCVIEN=I
Begin DoDot:1
+4 ;S BPCVIEN=$P($G(^TMP($J,XX)),U,3) W !,^TMP($J,XX)
+5 WRITE !,BPCVIEN
+6 DO LOT
+7 WRITE !,^BITMP($JOB),I
End DoDot:1
+8 QUIT
VACNAMS(BGUARRAY) ;EP CALL FROM REMOTE PROC: MDAO
+1 ;
VAC ;
+1 SET BPCGUI=1
SET X=""
KILL ^TMP($JOB)
+2 SET BGUARRAY="^TMP("_$JOB_")"
+3 IF $PIECE($GET(^BISITE(DUZ(2),0)),U,15)\1'=7
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="IMMUNIZATION VERSION INCORRECT!"
DO KILL
QUIT
+4 DO VACNAMS^BIRPC2(.X)
+5 SET BPCCTR=1
+6 SET X=""
FOR
SET X=$ORDER(^BITMP($JOB,"DILIST",1,X))
IF +X=0
QUIT
Begin DoDot:1
+7 SET BPCCTR=BPCCTR+1
+8 SET ^TMP($JOB,BPCCTR)=^BITMP($JOB,"DILIST",1,X)
+9 SET ^TMP($JOB,BPCCTR)=^TMP($JOB,BPCCTR)_U_$GET(^BITMP($JOB,"DILIST","ID",X,.02))
+10 SET ^TMP($JOB,BPCCTR)=^TMP($JOB,BPCCTR)_U_^BITMP($JOB,"DILIST",2,X)
End DoDot:1
+11 IF BPCCTR=1
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="No Vaccine list is available"
DO KILL
QUIT
+12 SET ^TMP($JOB,1)=BPCCTR
+13 DO KILL
+14 QUIT
LOTNUMS(BGUARRAY,BPCVIEN) ;EP CALL FROM REMOTE PROC: MDAO
LOT ;
+1 SET BPCGUI=1
SET X=""
KILL ^TMP($JOB)
+2 SET BGUARRAY="^TMP("_$JOB_")"
+3 IF $PIECE($GET(^BISITE(DUZ(2),0)),U,15)\1'=7
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="IMMUNIZATION VERSION INCORRECT!"
DO KILL
QUIT
+4 IF $GET(BPCVIEN)=""
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="VACCINE IEN NOT SENT!"
DO KILL
QUIT
+5 DO LOTNUMS^BIRPC2(X,BPCVIEN)
+6 QUIT
+7 SET BPCCTR=1
+8 SET X=""
FOR
SET X=$ORDER(^BITMP($JOB,"DILIST",1,X))
IF +X=0
QUIT
Begin DoDot:1
+9 SET BPCCTR=BPCCTR+1
+10 SET ^TMP($JOB,BPCCTR)=^BITMP($JOB,"DILIST",1,X)
+11 SET ^TMP($JOB,BPCCTR)=^TMP($JOB,BPCCTR)_U_$GET(^BITMP($JOB,"DILIST","ID",X,.02))
+12 SET ^TMP($JOB,BPCCTR)=^TMP($JOB,BPCCTR)_U_^BITMP($JOB,"DILIST",2,X)
End DoDot:1
+13 IF BPCCTR=1
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="No Vaccine list is available"
DO KILL
QUIT
+14 SET ^TMP($JOB,1)=BPCCTR
+15 DO KILL
+16 QUIT
USELOT(BGUARRAY,BPCLIEN) ;EP CALL FROM REMOTE PROC: BPC IMM LOT REQUIRED
+1 ;
ENL ;
+1 SET BPCGUI=1
SET XWBWRAP=1
SET X=""
KILL ^TMP($JOB)
+2 SET BGUARRAY="^TMP("_$JOB_")"
+3 ;TESTING
SET BPCLIEN=107
SET DUZ=1
+4 IF $PIECE($GET(^BISITE(DUZ(2),0)),U,15)\1'=7
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="IMMUNIZATION VERSION INCORRECT!"
DO KILL
QUIT
+5 IF $GET(BPCLIEN)=""
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="VACCINE IEN NOT SENT!"
DO KILL
QUIT
+6 SET BPCCTR=1
+7 SET X1=""
SET X1=$ORDER(^AUTTIML("C",BPCLIEN,X1))
IF X1=""
QUIT
Begin DoDot:1
+8 SET BPCCTR=BPCCTR+1
+9 SET ^TMP($JOB,BPCCTR)=X1
End DoDot:1
+10 IF BPCCTR=1
SET ^TMP($JOB,1)="1"
SET ^TMP($JOB,2)=0
QUIT
+11 IF BPCCTR=2
SET ^TMP($JOB,1)="1"
SET ^TMP($JOB,2)=1
+12 DO KILL
+13 QUIT
+14 ;
HIDOSE(BGUARRAY,BPCPIEN,BPCVIEN) ;EP CALL FROM REMOTE PROC: BPC IMM HIDOSE
+1 ;
ENDOSE ;
+1 SET BPCGUI=1
SET XWBWRAP=1
SET X=""
KILL ^TMP($JOB)
+2 SET BGUARRAY="^TMP("_$JOB_")"
+3 ;TESTING
SET BPCPIEN=25241
SET BPCVIEN=133
SET DUZ=1
+4 IF $GET(BPCPIEN)=""
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="PATIENT IEN NOT SENT!"
DO KILL
QUIT
+5 IF $GET(BPCVIEN)=""
SET ^TMP($JOB,1)=-1
SET ^TMP($JOB,2)="VACCINE IEN NOT SENT!"
DO KILL
QUIT
+6 SET (X,X1)=""
DO IMMHX^BIRPC(.X,25241)
+7 SET X1=$$HIDOSE^BIUTL11(25241,133,.X)
+8 SET ^TMP($JOB,1)="1"
SET ^TMP($JOB,2)=""
+9 IF +X1
SET ^TMP($JOB,2)=+X1
+10 DO KILL
+11 QUIT
+12 ;
KILL ;
+1 KILL BPCCTR,BPCGUI,BPCLIEN,BPCPIEN,BPCVIEN,X,X1,X2,X3,X4,X5,X6,X7,X8,XX
+2 QUIT
