BQIPTIMM ;PRXM/HC/ALA - PATIENT IMMUNIZATIONS ; 27 Mar 2007 11:00 AM
;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
;
Q
;
IMM(DATA,DFN,DRANGE) ; EP -- BQI PATIENT IMMUNIZATIONS
;
;Description - all the immunizations that a patient has
;
;Input
; DFN - Patient internal entry number
;
NEW UID,II,IEN,VISIT,VSDTM,IMMN,SERIES,LOT,REAC,SITE,VOL,VCDTM,ORPHY,ENPHY
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIPTIMM",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTIMM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S DRANGE=$$DATE^BQIUL1($G(DRANGE))
S @DATA@(II)="I00010IMM_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00100IMMUNIZATION^T00006SERIES^T00030REACTION^T00035ORD_PROV^T00035ENC_PROV"_$C(30)
S IEN=""
F S IEN=$O(^AUPNVIMM("AC",DFN,IEN),-1) Q:IEN="" D
. S IMMN=$$GET1^DIQ(9000010.11,IEN_",",.01,"E") I IMMN="" Q
. S VISIT=$$GET1^DIQ(9000010.11,IEN_",",.03,"I") I VISIT="" Q
. S VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I") I VSDTM=0 Q
. I DRANGE'="",(VSDTM\1<DRANGE) Q
. S SERIES=$$GET1^DIQ(9000010.11,IEN_",",.04,"E")
. S LOT=$$GET1^DIQ(9000010.11,IEN_",",.05,"E")
. S REAC=$$GET1^DIQ(9000010.11,IEN_",",.06,"E")
. S SITE=$$GET1^DIQ(9000010.11,IEN_",",.09,"E")
. S VOL=$$GET1^DIQ(9000010.11,IEN_",",.11,"E")
. S VCDTM=$$GET1^DIQ(9000010.11,IEN_",",.12,"I")
. S ORPHY=$$GET1^DIQ(9000010.11,IEN_",",1202,"E")
. S ENPHY=$$GET1^DIQ(9000010.11,IEN_",",1204,"E")
. S II=II+1,@DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_IMMN_U_SERIES_U_REAC_U_ORPHY_U_ENPHY_$C(30)
;
; Check for refusals
D REF
S II=II+1,@DATA@(II)=$C(31)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
Q
;
REF ; Check for refusals
NEW IMM,RVDT,REVDT,RFIEN,IMMUN,REAC,ORPHY,SERIES,ENPHY
S IMM=""
F S IMM=$O(^AUPNPREF("AA",DFN,9999999.14,IMM)) Q:IMM="" D
. S RVDT=""
. F S RVDT=$O(^AUPNPREF("AA",DFN,9999999.14,IMM,RVDT)) Q:RVDT="" D
.. ; Reverse the reverse date
.. S REVDT=9999999-RVDT
.. I DRANGE'="",(REVDT\1)<DRANGE Q
.. S RFIEN=""
.. F S RFIEN=$O(^AUPNPREF("AA",DFN,9999999.14,IMM,RVDT,RFIEN)) Q:RFIEN="" D
... S IMMUN=$$GET1^DIQ(9999999.14,IMM_",",.01,"E")
... S REAC=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
... S ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
... S SERIES="",ENPHY=""
... S II=II+1,@DATA@(II)=U_U_$$FMTE^BQIUL1(REVDT)_U_IMMUN_U_SERIES_U_REAC_U_ORPHY_U_ENPHY_$C(30)
Q
;
GLS(DATA,FAKE) ;EP - BQI GET IMMUNIZATIONS GLOSSARY
NEW UID,II,TRIEN,CAT,TIT,SORT,RMK,REMARK,CT,NXT,GLIEN,IEN,IIEN
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BQIIMGLS",UID))
K @DATA
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTIMM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
S @DATA@(II)="T32767REPORT_TEXT"_$C(30)
S GLIEN=$O(^BQI(90508.2,"B","Immunizations","")) I GLIEN="" S BMXSEC="Problem with Immunizations glossary in file 90508.2" G DONE
S IEN=0 F S IEN=$O(^BQI(90508.2,GLIEN,1,IEN)) Q:'IEN D
. S II=II+1,@DATA@(II)=$G(^BQI(90508.2,GLIEN,1,IEN,0))
;S GLIEN=$O(^BQI(90506.5,"B","Immunizations","")) I GLIEN="" S BMXSEC="Problem with Immunizations source list" G DONE
;S IEN=0 F S IEN=$O(^BQI(90506.5,GLIEN,10,IEN)) Q:'IEN D
;. S IIEN=$P(^BQI(90506.5,GLIEN,10,IEN,0),U,4)
;. S II=II+1,@DATA@(II)=" "_$P(^BQI(90506.5,GLIEN,10,IEN,0),U,3)_" ("_$P($G(^AUTTIMM(IIEN,1)),U,14)_")"
I II>0 S @DATA@(II)=@DATA@(II)_$C(30)
;
DONE S II=II+1,@DATA@(II)=$C(31)
Q
BQIPTIMM ;PRXM/HC/ALA - PATIENT IMMUNIZATIONS ; 27 Mar 2007 11:00 AM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
+2 ;
+3 QUIT
+4 ;
IMM(DATA,DFN,DRANGE) ; EP -- BQI PATIENT IMMUNIZATIONS
+1 ;
+2 ;Description - all the immunizations that a patient has
+3 ;
+4 ;Input
+5 ; DFN - Patient internal entry number
+6 ;
+7 NEW UID,II,IEN,VISIT,VSDTM,IMMN,SERIES,LOT,REAC,SITE,VOL,VCDTM,ORPHY,ENPHY
+8 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+9 SET DATA=$NAME(^TMP("BQIPTIMM",UID))
+10 KILL @DATA
+11 ;
+12 SET II=0
+13 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTIMM D UNWIND^%ZTER"
+14 ;
+15 SET DRANGE=$$DATE^BQIUL1($GET(DRANGE))
+16 SET @DATA@(II)="I00010IMM_IEN^I00010VISIT_IEN^D00030VISIT_DATETIME^T00100IMMUNIZATION^T00006SERIES^T00030REACTION^T00035ORD_PROV^T00035ENC_PROV"_$CHAR(30)
+17 SET IEN=""
+18 FOR
SET IEN=$ORDER(^AUPNVIMM("AC",DFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+19 SET IMMN=$$GET1^DIQ(9000010.11,IEN_",",.01,"E")
IF IMMN=""
QUIT
+20 SET VISIT=$$GET1^DIQ(9000010.11,IEN_",",.03,"I")
IF VISIT=""
QUIT
+21 SET VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")
IF VSDTM=0
QUIT
+22 IF DRANGE'=""
IF (VSDTM\1<DRANGE)
QUIT
+23 SET SERIES=$$GET1^DIQ(9000010.11,IEN_",",.04,"E")
+24 SET LOT=$$GET1^DIQ(9000010.11,IEN_",",.05,"E")
+25 SET REAC=$$GET1^DIQ(9000010.11,IEN_",",.06,"E")
+26 SET SITE=$$GET1^DIQ(9000010.11,IEN_",",.09,"E")
+27 SET VOL=$$GET1^DIQ(9000010.11,IEN_",",.11,"E")
+28 SET VCDTM=$$GET1^DIQ(9000010.11,IEN_",",.12,"I")
+29 SET ORPHY=$$GET1^DIQ(9000010.11,IEN_",",1202,"E")
+30 SET ENPHY=$$GET1^DIQ(9000010.11,IEN_",",1204,"E")
+31 SET II=II+1
SET @DATA@(II)=IEN_U_VISIT_U_$$FMTE^BQIUL1(VSDTM)_U_IMMN_U_SERIES_U_REAC_U_ORPHY_U_ENPHY_$CHAR(30)
End DoDot:1
+32 ;
+33 ; Check for refusals
+34 DO REF
+35 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+36 QUIT
+37 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 IF $DATA(II)
IF $DATA(DATA)
SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
REF ; Check for refusals
+1 NEW IMM,RVDT,REVDT,RFIEN,IMMUN,REAC,ORPHY,SERIES,ENPHY
+2 SET IMM=""
+3 FOR
SET IMM=$ORDER(^AUPNPREF("AA",DFN,9999999.14,IMM))
IF IMM=""
QUIT
Begin DoDot:1
+4 SET RVDT=""
+5 FOR
SET RVDT=$ORDER(^AUPNPREF("AA",DFN,9999999.14,IMM,RVDT))
IF RVDT=""
QUIT
Begin DoDot:2
+6 ; Reverse the reverse date
+7 SET REVDT=9999999-RVDT
+8 IF DRANGE'=""
IF (REVDT\1)<DRANGE
QUIT
+9 SET RFIEN=""
+10 FOR
SET RFIEN=$ORDER(^AUPNPREF("AA",DFN,9999999.14,IMM,RVDT,RFIEN))
IF RFIEN=""
QUIT
Begin DoDot:3
+11 SET IMMUN=$$GET1^DIQ(9999999.14,IMM_",",.01,"E")
+12 SET REAC=$$GET1^DIQ(9000022,RFIEN_",",.07,"E")
+13 SET ORPHY=$$GET1^DIQ(9000022,RFIEN_",",1204,"E")
+14 SET SERIES=""
SET ENPHY=""
+15 SET II=II+1
SET @DATA@(II)=U_U_$$FMTE^BQIUL1(REVDT)_U_IMMUN_U_SERIES_U_REAC_U_ORPHY_U_ENPHY_$CHAR(30)
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
GLS(DATA,FAKE) ;EP - BQI GET IMMUNIZATIONS GLOSSARY
+1 NEW UID,II,TRIEN,CAT,TIT,SORT,RMK,REMARK,CT,NXT,GLIEN,IEN,IIEN
+2 ;
+3 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+4 SET DATA=$NAME(^TMP("BQIIMGLS",UID))
+5 KILL @DATA
+6 ;
+7 SET II=0
+8 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BQIPTIMM D UNWIND^%ZTER"
+9 ;
+10 SET @DATA@(II)="T32767REPORT_TEXT"_$CHAR(30)
+11 SET GLIEN=$ORDER(^BQI(90508.2,"B","Immunizations",""))
IF GLIEN=""
SET BMXSEC="Problem with Immunizations glossary in file 90508.2"
GOTO DONE
+12 SET IEN=0
FOR
SET IEN=$ORDER(^BQI(90508.2,GLIEN,1,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+13 SET II=II+1
SET @DATA@(II)=$GET(^BQI(90508.2,GLIEN,1,IEN,0))
End DoDot:1
+14 ;S GLIEN=$O(^BQI(90506.5,"B","Immunizations","")) I GLIEN="" S BMXSEC="Problem with Immunizations source list" G DONE
+15 ;S IEN=0 F S IEN=$O(^BQI(90506.5,GLIEN,10,IEN)) Q:'IEN D
+16 ;. S IIEN=$P(^BQI(90506.5,GLIEN,10,IEN,0),U,4)
+17 ;. S II=II+1,@DATA@(II)=" "_$P(^BQI(90506.5,GLIEN,10,IEN,0),U,3)_" ("_$P($G(^AUTTIMM(IIEN,1)),U,14)_")"
+18 IF II>0
SET @DATA@(II)=@DATA@(II)_$CHAR(30)
+19 ;
DONE SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
