BQIPTIMP.m

BQIPTIMP ;VNGT/HS/ALA-Patient Immunization Forecast Profile ; 28 Jan 2011  8:40 AM

 ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59

 ;

 ;

EN(DATA,DFN) ;EP -- BQI PATIENT IMMUN PROFILE

 ;

 ;Input

 ;  DFN - Patient internal entry number

 ;

 NEW UID,II,GLOB,HDR,BIDLLID,BIDLLRUN,BIRESULT,BISITE

 S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)

 S DATA=$NA(^TMP("BQIPTIMP",UID)),GLOB=$NA(^TMP("BQIIZ",UID))

 K @DATA,@GLOB

 ;

 S II=0

 NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIPTIMM D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2

 S HDR="T01024REPORT"

 S @DATA@(II)=HDR_$C(30)

 D IMMPROF^BIRPC(.GLOB,DFN,"","")

 S N=0,II=II+1

 F  S N=$O(@GLOB@(N)) Q:N=""  D

 . NEW XX

 . S XX=$$CTRL^BQIUL1(@GLOB@(N))

 . S @DATA@(II)=$G(@DATA@(II))_XX_$C(13)_$C(10)

 S @DATA@(II)=@DATA@(II)_$C(30)

 S II=II+1,@DATA@(II)=$C(31)

 K @GLOB

 Q

BQIPTIMP  ;VNGT/HS/ALA-Patient Immunization Forecast Profile ; 28 Jan 2011  8:40 AM

 +1       ;;2.3;ICARE MANAGEMENT SYSTEM;;Apr 18, 2012;Build 59

 +2       ;

 +3       ;

EN(DATA,DFN) ;EP -- BQI PATIENT IMMUN PROFILE

 +1       ;

 +2       ;Input

 +3       ;  DFN - Patient internal entry number

 +4       ;

 +5        NEW UID,II,GLOB,HDR,BIDLLID,BIDLLRUN,BIRESULT,BISITE

 +6        SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)

 +7        SET DATA=$NAME(^TMP("BQIPTIMP",UID))

           SET GLOB=$NAME(^TMP("BQIIZ",UID))

 +8        KILL @DATA,@GLOB

 +9       ;

 +10       SET II=0

 +11      ; SAC 2006 2.2.3.3.2

           NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^BQIPTIMM D UNWIND^%ZTER"

 +12       SET HDR="T01024REPORT"

 +13       SET @DATA@(II)=HDR_$CHAR(30)

 +14       DO IMMPROF^BIRPC(.GLOB,DFN,"","")

 +15       SET N=0

           SET II=II+1

 +16       FOR 

               SET N=$ORDER(@GLOB@(N))

               IF N=""

                   QUIT 

               Begin DoDot:1

 +17               NEW XX

 +18               SET XX=$$CTRL^BQIUL1(@GLOB@(N))

 +19               SET @DATA@(II)=$GET(@DATA@(II))_XX_$CHAR(13)_$CHAR(10)

               End DoDot:1

 +20       SET @DATA@(II)=@DATA@(II)_$CHAR(30)

 +21       SET II=II+1

           SET @DATA@(II)=$CHAR(31)

 +22       KILL @GLOB

 +23       QUIT