Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPCIMDSP

BPCIMDSP.m

Go to the documentation of this file. 
  1. BPCIMDSP ; IHS/OIT/MJL - IMMUN HISTORY DISP GUI RPC ROUTINE ;
  1.  ;;1.5;BPC;;MAY 26, 2005
  1.  ;
  1. GETIHDSP(BGUARRAY,BPCPIEN) ;EP CALL FROM REMOTE PROC: BPC GET IMM HISTORY DATA
  1.  ;
  1. ENH ;
  1.  ;Return array format
  1.  ;  1=visit date
  1.  ;  2=dose-vac or skin test name
  1.  ;  3=imm reaction
  1.  ;  4=skin result
  1.  ;  5=location
  1.  ;  6=skin reading
  1.  ;  7=skin reading date fm format
  1.  ;  8=imm or skin long name
  1.  ;  9=imm or skin IEN
  1.  ;  10=visit IEN
  1.  ;  11=I or S for type
  1.  ;  12=V File IEN
  1.  ;  13=encounter provider
  1.  ;  14=Visit date in fm format
  1.  S BPCGUI=1,X="",XWBWRAP=1 K ^TMP($J)
  1.  S BGUARRAY="^TMP("_$J_")"
  1.  ;S BPCPIEN=25241,DUZ=1 ;TESTING
  1.  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
  1.  I $G(BPCPIEN)="" S ^TMP($J,1)=-1,^TMP($J,2)="PATIENT IEN NOT SENT!" D KILL Q
  1.  S X="BILOGO",BPCBIOS="" X ^%ZOSF("TEST") I $T S BPCX=$$VER^BILOGO I BPCX["8." S BPCBIOS=1  ;FJE
  1.  D IMMHX^BIRPC(.X,BPCPIEN)
  1. FJ S BPCCTR=1
  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
  1.  . S BPCCTR=BPCCTR+1
  1.  . F I=1:1:15 S X(I)=$P(X1,"|",I)
  1.  . S ^TMP($J,BPCCTR)=X(7)
  1.  . F K=3,13,8,5,9,10 S ^TMP($J,BPCCTR)=^TMP($J,BPCCTR)_U_X(K)
  1.  . S $P(^TMP($J,BPCCTR),U,11)=X(1),$P(^TMP($J,BPCCTR),U,12)=X(4)
  1.  . I +X(15) S $P(^TMP($J,BPCCTR),U,13)=$P($G(^VA(200,X(15),0)),U,1)
  1.  . I X(1)="I" D
  1.  .. 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)
  1.  .. S Y=$P($G(^AUPNVIMM(X(4),0)),U,1),$P(^TMP($J,BPCCTR),U,9)=+Y
  1.  .. S Y=$P($G(^AUPNVIMM(X(4),0)),U,3),$P(^TMP($J,BPCCTR),U,10)=+Y
  1.  .. S Y=$P($G(^AUPNVSIT(+Y,0)),U,1),$P(^TMP($J,BPCCTR),U,14)=Y
  1.  .. I BPCBIOS S $P(^TMP($J,BPCCTR),U,2)=X(2) ;FJE
  1.  . I X(1)="S" D
  1.  .. S $P(^TMP($J,BPCCTR),U,2)=X(11)
  1.  .. I +X(12) S Y=$P($G(^AUTTSK(X(12),0)),U,1),$P(^TMP($J,BPCCTR),U,8)=Y
  1.  .. S Y=$P($G(^AUPNVSK(X(4),0)),U,1),$P(^TMP($J,BPCCTR),U,9)=+Y
  1.  .. S Y=$P($G(^AUPNVSK(X(4),0)),U,3),$P(^TMP($J,BPCCTR),U,10)=+Y
  1.  .. S Y=$P($G(^AUPNVSIT(+Y,0)),U,1),$P(^TMP($J,BPCCTR),U,14)=Y
  1.  D CONTRAS^BIRPC5(.X,BPCPIEN)
  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
  1.  . S BPCCTR=BPCCTR+1
  1.  . F I=1:1:4 S X(I)=$P(X1,"|",I)
  1.  . S ^TMP($J,BPCCTR)=X(4)_U_X(2)_U_"Contraindication"_U_X(3)
  1.  . S $P(^TMP($J,BPCCTR),U,11)="C"
  1.  I BPCCTR=1 S ^TMP($J,1)="1",^TMP($J,2)="No Data Available" D KILL Q
  1.  S ^TMP($J,1)=BPCCTR
  1.  D KILL
  1.  Q
  1. GETIFDSP(BGUARRAY,BPCPIEN) ;EP CALL FROM REMOTE PROC: BPC GET IMM FORECAST DATA
  1.  ;
  1. ENF ;
  1.  S BPCGUI=1,XWBWRAP=1 K ^TMP($J)
  1.  S BGUARRAY="^TMP("_$J_")"
  1.  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
  1.  ;S BPCPIEN=25241,DUZ=1,DUZ(0)=4585 TESTING D ENF^BPCIMDSP
  1.  ;S BPCPIEN=1,DUZ=1,DUZ(0)=4585
  1.  I $G(BPCPIEN)="" S ^TMP($J,1)=-1,^TMP($J,2)="PATIENT IEN NOT SENT!" D KILL Q
  1.  K X S X=""
  1.  D IMMFORC^BIRPC(.X,BPCPIEN)
  1.  I X["Forecasting disabled" S ^TMP($J,1)="1",^TMP($J,2)=$P(X,$C(31),3) D KILL Q
  1.  I X["Forecasting disabled" S ^TMP($J,1)="1",^TMP($J,2)=$P(X,".") D KILL Q
  1.  ;I X["No immunizations due" S ^TMP($J,1)="1",^TMP($J,2)=$P(X,$C(31),3) D KILL Q
  1.  I X["No immunizations due" S ^TMP($J,1)="1",^TMP($J,2)=$P(X,".") D KILL Q
  1.  S BPCCTR=1
  1.  S X1=0 F I=1:1 S X1=$P(X,U,I) Q:$A($E(X1,2))=31  D
  1.  . S BPCCTR=BPCCTR+1
  1.  . S X2=$P(X1,"|",1),X6=$E(X2,3,99)
  1.  . S X3=$P(X1,"|",2),X4=$P(X1,"|",3)
  1.  . S X7="",X7=$O(^AUTTIMM("D",X6,X7))
  1.  . S X5="" I +X7 S X5=$G(^AUTTIMM(X7,0)),X5=$P(X5,U,1)
  1.  . S X8=+X2 S:X8=0 X8=""
  1.  . S ^TMP($J,BPCCTR)=X2_U_X3_U_X4_U_X5_U_X8_U_X7
  1.  I BPCCTR=1 S ^TMP($J,1)="1",^TMP($J,2)="No Data Available" D KILL Q
  1.  S ^TMP($J,1)=BPCCTR
  1.  D KILL
  1.  Q
  1. TESTF ;TESTS FOR SEVERAL PATIENTS
  1.  S XX=0 F  S XX=$O(^DPT(XX)) Q:+XX=0  D
  1.  . S BPCPIEN=XX,DUZ=1,DUZ(2)=4585
  1.  . D ENF
  1.  . W !,X
  1.  Q
  1. TESTH ;TESTS FOR SEVERAL PATIENTS
  1.  S XX=0 F  S XX=$O(^DPT(XX)) Q:+XX=0  D
  1.  . S BPCPIEN=XX,DUZ=1,DUZ(2)=4585
  1.  . D ENH
  1.  . W !,X
  1.  Q
  1. TESTL ;TESTS FOR SEVERAL LOTS
  1.  S U="^" D VAC
  1.  ;S XX=1 F  S XX=$O(^TMP($J,XX)) Q:+XX=0  D
  1.  F I=106,107,113,115,117 S BPCVIEN=I  D
  1.  . ;S BPCVIEN=$P($G(^TMP($J,XX)),U,3) W !,^TMP($J,XX)
  1.  . W !,BPCVIEN
  1.  . D LOT
  1.  . W !,^BITMP($J),I
  1.  Q
  1. VACNAMS(BGUARRAY) ;EP CALL FROM REMOTE PROC: MDAO
  1.  ;
  1. VAC ;
  1.  S BPCGUI=1,X="" K ^TMP($J)
  1.  S BGUARRAY="^TMP("_$J_")"
  1.  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
  1.  D VACNAMS^BIRPC2(.X)
  1.  S BPCCTR=1
  1.  S X="" F  S X=$O(^BITMP($J,"DILIST",1,X)) Q:+X=0  D
  1.  . S BPCCTR=BPCCTR+1
  1.  . S ^TMP($J,BPCCTR)=^BITMP($J,"DILIST",1,X)
  1.  . S ^TMP($J,BPCCTR)=^TMP($J,BPCCTR)_U_$G(^BITMP($J,"DILIST","ID",X,.02))
  1.  . S ^TMP($J,BPCCTR)=^TMP($J,BPCCTR)_U_^BITMP($J,"DILIST",2,X)
  1.  I BPCCTR=1 S ^TMP($J,1)=-1,^TMP($J,2)="No Vaccine list is available" D KILL Q
  1.  S ^TMP($J,1)=BPCCTR
  1.  D KILL
  1.  Q
  1. LOTNUMS(BGUARRAY,BPCVIEN) ;EP CALL FROM REMOTE PROC: MDAO
  1. LOT ;
  1.  S BPCGUI=1,X="" K ^TMP($J)
  1.  S BGUARRAY="^TMP("_$J_")"
  1.  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
  1.  I $G(BPCVIEN)="" S ^TMP($J,1)=-1,^TMP($J,2)="VACCINE IEN NOT SENT!" D KILL Q
  1.  D LOTNUMS^BIRPC2(X,BPCVIEN)
  1.  Q
  1.  S BPCCTR=1
  1.  S X="" F  S X=$O(^BITMP($J,"DILIST",1,X)) Q:+X=0  D
  1.  . S BPCCTR=BPCCTR+1
  1.  . S ^TMP($J,BPCCTR)=^BITMP($J,"DILIST",1,X)
  1.  . S ^TMP($J,BPCCTR)=^TMP($J,BPCCTR)_U_$G(^BITMP($J,"DILIST","ID",X,.02))
  1.  . S ^TMP($J,BPCCTR)=^TMP($J,BPCCTR)_U_^BITMP($J,"DILIST",2,X)
  1.  I BPCCTR=1 S ^TMP($J,1)=-1,^TMP($J,2)="No Vaccine list is available" D KILL Q
  1.  S ^TMP($J,1)=BPCCTR
  1.  D KILL
  1.  Q
  1. USELOT(BGUARRAY,BPCLIEN)  ;EP CALL FROM REMOTE PROC: BPC IMM LOT REQUIRED
  1.  ;
  1. ENL ;
  1.  S BPCGUI=1,XWBWRAP=1,X="" K ^TMP($J)
  1.  S BGUARRAY="^TMP("_$J_")"
  1.  S BPCLIEN=107,DUZ=1 ;TESTING
  1.  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
  1.  I $G(BPCLIEN)="" S ^TMP($J,1)=-1,^TMP($J,2)="VACCINE IEN NOT SENT!" D KILL Q
  1.  S BPCCTR=1
  1.  S X1="",X1=$O(^AUTTIML("C",BPCLIEN,X1)) Q:X1=""  D
  1.  . S BPCCTR=BPCCTR+1
  1.  . S ^TMP($J,BPCCTR)=X1
  1.  I BPCCTR=1 S ^TMP($J,1)="1",^TMP($J,2)=0 Q
  1.  I BPCCTR=2 S ^TMP($J,1)="1",^TMP($J,2)=1
  1.  D KILL
  1.  Q
  1.  ;
  1. HIDOSE(BGUARRAY,BPCPIEN,BPCVIEN)  ;EP CALL FROM REMOTE PROC: BPC IMM HIDOSE
  1.  ;
  1. ENDOSE ;
  1.  S BPCGUI=1,XWBWRAP=1,X="" K ^TMP($J)
  1.  S BGUARRAY="^TMP("_$J_")"
  1.  S BPCPIEN=25241,BPCVIEN=133,DUZ=1 ;TESTING
  1.  I $G(BPCPIEN)="" S ^TMP($J,1)=-1,^TMP($J,2)="PATIENT IEN NOT SENT!" D KILL Q
  1.  I $G(BPCVIEN)="" S ^TMP($J,1)=-1,^TMP($J,2)="VACCINE IEN NOT SENT!" D KILL Q
  1.  S (X,X1)="" D IMMHX^BIRPC(.X,25241)
  1.  S X1=$$HIDOSE^BIUTL11(25241,133,.X)
  1.  S ^TMP($J,1)="1",^TMP($J,2)=""
  1.  S:+X1 ^TMP($J,2)=+X1
  1.  D KILL
  1.  Q
  1.  ;
  1. KILL ;
  1.  K BPCCTR,BPCGUI,BPCLIEN,BPCPIEN,BPCVIEN,X,X1,X2,X3,X4,X5,X6,X7,X8,XX
  1.  Q