- NHINVIMM ;SLC/MKB -- Immunizations extract
- ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
- ;
- ; External References DBIA#
- ; ------------------- -----
- ; ^DIC(4 10090
- ; ^VA(200 10060
- ; DIC 2051
- ; DIQ 2056
- ; PXRHS03,^TMP("PXI",$J) 1239
- ; XUAF4 2171
- ;
- ; ------------ Get immunizations from VistA ------------
- ;
- EN(DFN,BEG,END,MAX,IFN) ; -- find patient's immunizations
- N NHITM,NHICNT,NM,IDT,X
- S DFN=+$G(DFN) Q:DFN<1 ;invalid patient
- S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999),NHICNT=0
- K ^TMP("PXI",$J) D IMMUN^PXRHS03(DFN)
- ;
- ; get one immunization
- I $G(IFN) D Q
- . N DONE S DONE=0
- . S NM="" F S NM=$O(^TMP("PXI",$J,NM)) Q:NM="" D Q:DONE
- .. S IDT=0 F S IDT=$O(^TMP("PXI",$J,NM,IDT)) Q:IDT<1 I $D(^(IDT,IFN)) D Q
- ... D EN1(.NHITM),XML(.NHITM)
- ... S DONE=1
- . K ^TMP("PXI",$J)
- ;
- ; get all immunizations
- S X=BEG,BEG=9999999-END-.000001,END=9999999-X I $L(END,".")<2 S END=END_".2359"
- S NM="" F S NM=$O(^TMP("PXI",$J,NM)) Q:NM="" D
- . S IDT=BEG F S IDT=$O(^TMP("PXI",$J,NM,IDT)) Q:IDT<1!(IDT>END) D
- .. S IFN=0 F S IFN=$O(^TMP("PXI",$J,NM,IDT,IFN)) Q:IFN<1 D Q:NHICNT'<MAX
- ... K NHITM D EN1(.NHITM),XML(.NHITM)
- ... S NHICNT=NHICNT+1
- K ^TMP("PXI",$J)
- Q
- ;
- EN1(IMM) ; -- return an immunization in IMM("attribute")=value
- ; Expects ^TMP("PXI",$J,NM,IDT,IFN) from IMMUN^PXRHS03
- N X0,X1,CPT,DA,X,Y K IMM
- S X0=$G(^TMP("PXI",$J,NM,IDT,IFN,0)),X1=$G(^(1)),X=$G(^("COM"))
- S:$L(X) IMM("comment")=X
- S IMM("id")=IFN,IMM("name")=$P(X0,U)
- S IMM("administered")=+$P(X0,U,3)
- S IMM("series")=$P(X0,U,5)
- S IMM("reaction")=$P(X0,U,6)
- S IMM("contraindicated")=+$P(X0,U,7)
- S IMM("location")=$P(X1,U)
- S X=$P(X1,U,3) I $L(X) D
- . S Y=$$LKUP^XUAF4(X) ;ien
- . I Y<1 S Y=+$O(^DIC(4,"B",X,0)) ;dupl -> get 1st
- . S IMM("facility")=$$STA^XUAF4(Y)_U_X
- I '$D(IMM("facility")) S IMM("facility")=$$FAC^NHINV
- S X=$P(X0,U,9) S:'$L(X) X=$P(X0,U,8)
- I $L(X) S IMM("provider")=+$O(^VA(200,"B",X,0))_U_X
- ;
- S DA=+$$GET1^DIQ(9000010.11,IFN_",",.01,"I") Q:'DA
- S X=+$$FIND1^DIC(811.1,,"QX",DA_";AUTTIMM(","B") I X>0 D
- . S Y=$$GET1^DIQ(811.1,X_",",.02,"I") Q:Y<1
- . S CPT=$G(@(U_$P(Y,";",2)_+Y_",0)"))
- . S IMM("cpt")=$P(CPT,U,1,2)
- Q
- ;
- ; ------------ Return data to middle tier ------------
- ;
- XML(IMM) ; -- Return immunizations as XML
- N ATT,X,Y,I,P,NAMES,TAG
- D ADD("<immunization>") S NHINTOTL=$G(NHINTOTL)+1
- S ATT="" F S ATT=$O(IMM(ATT)) Q:ATT="" D
- . S X=$G(IMM(ATT)),Y="" Q:'$L(X)
- . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" D ADD(Y) Q
- . I $L(X)>1 D
- .. S Y="<"_ATT_" "
- .. F P=1:1 S TAG=$P("code^name^Z",U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
- .. S Y=Y_"/>" D ADD(Y)
- D ADD("</immunization>")
- Q
- ;
- ADD(X) ; -- Add a line @NHIN@(n)=X
- S NHINI=$G(NHINI)+1
- S @NHIN@(NHINI)=X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNHINVIMM 2989 printed Apr 23, 2025@18:31:47 Page 2
- NHINVIMM ;SLC/MKB -- Immunizations extract
- +1 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
- +2 ;
- +3 ; External References DBIA#
- +4 ; ------------------- -----
- +5 ; ^DIC(4 10090
- +6 ; ^VA(200 10060
- +7 ; DIC 2051
- +8 ; DIQ 2056
- +9 ; PXRHS03,^TMP("PXI",$J) 1239
- +10 ; XUAF4 2171
- +11 ;
- +12 ; ------------ Get immunizations from VistA ------------
- +13 ;
- EN(DFN,BEG,END,MAX,IFN) ; -- find patient's immunizations
- +1 NEW NHITM,NHICNT,NM,IDT,X
- +2 ;invalid patient
- SET DFN=+$GET(DFN)
- if DFN<1
- QUIT
- +3 SET BEG=$GET(BEG,1410101)
- SET END=$GET(END,9999998)
- SET MAX=$GET(MAX,999999)
- SET NHICNT=0
- +4 KILL ^TMP("PXI",$JOB)
- DO IMMUN^PXRHS03(DFN)
- +5 ;
- +6 ; get one immunization
- +7 IF $GET(IFN)
- Begin DoDot:1
- +8 NEW DONE
- SET DONE=0
- +9 SET NM=""
- FOR
- SET NM=$ORDER(^TMP("PXI",$JOB,NM))
- if NM=""
- QUIT
- Begin DoDot:2
- +10 SET IDT=0
- FOR
- SET IDT=$ORDER(^TMP("PXI",$JOB,NM,IDT))
- if IDT<1
- QUIT
- IF $DATA(^(IDT,IFN))
- Begin DoDot:3
- +11 DO EN1(.NHITM)
- DO XML(.NHITM)
- +12 SET DONE=1
- End DoDot:3
- QUIT
- End DoDot:2
- if DONE
- QUIT
- +13 KILL ^TMP("PXI",$JOB)
- End DoDot:1
- QUIT
- +14 ;
- +15 ; get all immunizations
- +16 SET X=BEG
- SET BEG=9999999-END-.000001
- SET END=9999999-X
- IF $LENGTH(END,".")<2
- SET END=END_".2359"
- +17 SET NM=""
- FOR
- SET NM=$ORDER(^TMP("PXI",$JOB,NM))
- if NM=""
- QUIT
- Begin DoDot:1
- +18 SET IDT=BEG
- FOR
- SET IDT=$ORDER(^TMP("PXI",$JOB,NM,IDT))
- if IDT<1!(IDT>END)
- QUIT
- Begin DoDot:2
- +19 SET IFN=0
- FOR
- SET IFN=$ORDER(^TMP("PXI",$JOB,NM,IDT,IFN))
- if IFN<1
- QUIT
- Begin DoDot:3
- +20 KILL NHITM
- DO EN1(.NHITM)
- DO XML(.NHITM)
- +21 SET NHICNT=NHICNT+1
- End DoDot:3
- if NHICNT'<MAX
- QUIT
- End DoDot:2
- End DoDot:1
- +22 KILL ^TMP("PXI",$JOB)
- +23 QUIT
- +24 ;
- EN1(IMM) ; -- return an immunization in IMM("attribute")=value
- +1 ; Expects ^TMP("PXI",$J,NM,IDT,IFN) from IMMUN^PXRHS03
- +2 NEW X0,X1,CPT,DA,X,Y
- KILL IMM
- +3 SET X0=$GET(^TMP("PXI",$JOB,NM,IDT,IFN,0))
- SET X1=$GET(^(1))
- SET X=$GET(^("COM"))
- +4 if $LENGTH(X)
- SET IMM("comment")=X
- +5 SET IMM("id")=IFN
- SET IMM("name")=$PIECE(X0,U)
- +6 SET IMM("administered")=+$PIECE(X0,U,3)
- +7 SET IMM("series")=$PIECE(X0,U,5)
- +8 SET IMM("reaction")=$PIECE(X0,U,6)
- +9 SET IMM("contraindicated")=+$PIECE(X0,U,7)
- +10 SET IMM("location")=$PIECE(X1,U)
- +11 SET X=$PIECE(X1,U,3)
- IF $LENGTH(X)
- Begin DoDot:1
- +12 ;ien
- SET Y=$$LKUP^XUAF4(X)
- +13 ;dupl -> get 1st
- IF Y<1
- SET Y=+$ORDER(^DIC(4,"B",X,0))
- +14 SET IMM("facility")=$$STA^XUAF4(Y)_U_X
- End DoDot:1
- +15 IF '$DATA(IMM("facility"))
- SET IMM("facility")=$$FAC^NHINV
- +16 SET X=$PIECE(X0,U,9)
- if '$LENGTH(X)
- SET X=$PIECE(X0,U,8)
- +17 IF $LENGTH(X)
- SET IMM("provider")=+$ORDER(^VA(200,"B",X,0))_U_X
- +18 ;
- +19 SET DA=+$$GET1^DIQ(9000010.11,IFN_",",.01,"I")
- if 'DA
- QUIT
- +20 SET X=+$$FIND1^DIC(811.1,,"QX",DA_";AUTTIMM(","B")
- IF X>0
- Begin DoDot:1
- +21 SET Y=$$GET1^DIQ(811.1,X_",",.02,"I")
- if Y<1
- QUIT
- +22 SET CPT=$GET(@(U_$PIECE(Y,";",2)_+Y_",0)"))
- +23 SET IMM("cpt")=$PIECE(CPT,U,1,2)
- End DoDot:1
- +24 QUIT
- +25 ;
- +26 ; ------------ Return data to middle tier ------------
- +27 ;
- XML(IMM) ; -- Return immunizations as XML
- +1 NEW ATT,X,Y,I,P,NAMES,TAG
- +2 DO ADD("<immunization>")
- SET NHINTOTL=$GET(NHINTOTL)+1
- +3 SET ATT=""
- FOR
- SET ATT=$ORDER(IMM(ATT))
- if ATT=""
- QUIT
- Begin DoDot:1
- +4 SET X=$GET(IMM(ATT))
- SET Y=""
- if '$LENGTH(X)
- QUIT
- +5 IF X'["^"
- SET Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />"
- DO ADD(Y)
- QUIT
- +6 IF $LENGTH(X)>1
- Begin DoDot:2
- +7 SET Y="<"_ATT_" "
- +8 FOR P=1:1
- SET TAG=$PIECE("code^name^Z",U,P)
- if TAG="Z"
- QUIT
- IF $LENGTH($PIECE(X,U,P))
- SET Y=Y_TAG_"='"_$$ESC^NHINV($PIECE(X,U,P))_"' "
- +9 SET Y=Y_"/>"
- DO ADD(Y)
- End DoDot:2
- End DoDot:1
- +10 DO ADD("</immunization>")
- +11 QUIT
- +12 ;
- ADD(X) ; -- Add a line @NHIN@(n)=X
- +1 SET NHINI=$GET(NHINI)+1
- +2 SET @NHIN@(NHINI)=X
- +3 QUIT
