BPXRMIM2.m

BPXRMIM2 ; IHS/MSC/MGH - Handle Computed findings for immunizations. ;18-Apr-2014 15:24;DU

 ;;2.0;CLINICAL REMINDERS;**1001,1002**;Feb 04, 2005;Build 15

 ;=================================================================

 ;This routine is designed to search  the immunication forcast

 ;data to determine if an immunization is due for a child requiring a

 ;series immunization

 ;Fixed call to standard call for forecaster

 ;1005 Changed and added call to forecaster to display last date done

 ;if the reminder is due

 ;=====================================================================

GETVAR(BPXTRM) ;EP

 ;Get the needed data from the reminder term. This includes the date range

 ;the test name(s) and the value to search for

 N X,Y,BPXFIND,BPXTYPE,BPXFILE,BPXCOND,BPXOFF,BPXVAL,BPXRESLT,BPXLAST

 N BPXCNT,BPXHI,TARGET,BPXTEST,TSTRING

 S TSTRING=""

 K ^TMP("BPXIMM",$J)

 S BPXCNT=0,BPXHI=0,BPXRESLT=0

 S TODAY=$$DT^XLFDT()

 S TARGET="^TMP(""BPXIMM"",$J)"

 S BPXFIND=0 F  S BPXFIND=$O(^PXRMD(811.5,BPXTRM,20,BPXFIND)) Q:BPXFIND=""!(BPXFIND?1A.A)!(BPXRESLT=1)  D

 .S BPXTYPE=$P($G(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,1)

 .S BPXTEST=$P(BPXTYPE,";",1),BPXFILE=$P(BPXTYPE,";",2)

 .Q:BPXFILE'="AUTTIMM("

 .S BPXOFF=$P($G(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,8)

 .S BPXOFF="-"_BPXOFF

 .;Call next routine with patient,start and stop dates,test name

 .S BPXRESLT=$$RESULT^BPXRMIM2(DFN,BPXTEST)

 I BPXRESLT=1 S TEST=0,VALUE=TEST

 I BPXRESLT=0 S TEST=1,VALUE=TEST,DATE=TODAY

 Q

RESULT(DFN,TEST) ;Find what is due

 ;Search the imunization forecast file to find the chosen  immunizations

 N BPXFOR,BPXIMM,BPXDONE,BPXSTR,TNAME,BIHX,BIDE,TCODE

 S BPXDONE=0

 ;Changed called Patch 1004 to standard call for forecaster

 S TNAME=$P(^AUTTIMM(TEST,0),U,2),TCODE=$P(^AUTTIMM(TEST,0),U,3)

 I TSTRING="" S TSTRING=TCODE

 I TSTRING'="" S TSTRING=TSTRING_","_TCODE

 ;Call the forecaster code to return the data

 D IMMFORC^BIRPC(.BPXSTR,DFN)

 F I=1:1 S BPXFOR=$P(BPXSTR,"^",I) Q:BPXFOR=""  D

 .S BPXIMM=$P(BPXFOR,"|",1)

 .;See if the immunization is due

 .I BPXIMM[TNAME S BPXDONE=1

 .;Find the date last done

 .S DATE=$$LASTIMM^BIUTL11(DFN,TSTRING)

 Q BPXDONE

BPXRMIM2  ; IHS/MSC/MGH - Handle Computed findings for immunizations. ;18-Apr-2014 15:24;DU

 +1       ;;2.0;CLINICAL REMINDERS;**1001,1002**;Feb 04, 2005;Build 15

 +2       ;=================================================================

 +3       ;This routine is designed to search  the immunication forcast

 +4       ;data to determine if an immunization is due for a child requiring a

 +5       ;series immunization

 +6       ;Fixed call to standard call for forecaster

 +7       ;1005 Changed and added call to forecaster to display last date done

 +8       ;if the reminder is due

 +9       ;=====================================================================

GETVAR(BPXTRM) ;EP

 +1       ;Get the needed data from the reminder term. This includes the date range

 +2       ;the test name(s) and the value to search for

 +3        NEW X,Y,BPXFIND,BPXTYPE,BPXFILE,BPXCOND,BPXOFF,BPXVAL,BPXRESLT,BPXLAST

 +4        NEW BPXCNT,BPXHI,TARGET,BPXTEST,TSTRING

 +5        SET TSTRING=""

 +6        KILL ^TMP("BPXIMM",$JOB)

 +7        SET BPXCNT=0

           SET BPXHI=0

           SET BPXRESLT=0

 +8        SET TODAY=$$DT^XLFDT()

 +9        SET TARGET="^TMP(""BPXIMM"",$J)"

 +10       SET BPXFIND=0

           FOR 

               SET BPXFIND=$ORDER(^PXRMD(811.5,BPXTRM,20,BPXFIND))

               IF BPXFIND=""!(BPXFIND?1A.A)!(BPXRESLT=1)

                   QUIT 

               Begin DoDot:1

 +11               SET BPXTYPE=$PIECE($GET(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,1)

 +12               SET BPXTEST=$PIECE(BPXTYPE,";",1)

                   SET BPXFILE=$PIECE(BPXTYPE,";",2)

 +13               IF BPXFILE'="AUTTIMM("

                       QUIT 

 +14               SET BPXOFF=$PIECE($GET(^PXRMD(811.5,BPXTRM,20,BPXFIND,0)),U,8)

 +15               SET BPXOFF="-"_BPXOFF

 +16      ;Call next routine with patient,start and stop dates,test name

 +17               SET BPXRESLT=$$RESULT^BPXRMIM2(DFN,BPXTEST)

               End DoDot:1

 +18       IF BPXRESLT=1

               SET TEST=0

               SET VALUE=TEST

 +19       IF BPXRESLT=0

               SET TEST=1

               SET VALUE=TEST

               SET DATE=TODAY

 +20       QUIT 

RESULT(DFN,TEST) ;Find what is due

 +1       ;Search the imunization forecast file to find the chosen  immunizations

 +2        NEW BPXFOR,BPXIMM,BPXDONE,BPXSTR,TNAME,BIHX,BIDE,TCODE

 +3        SET BPXDONE=0

 +4       ;Changed called Patch 1004 to standard call for forecaster

 +5        SET TNAME=$PIECE(^AUTTIMM(TEST,0),U,2)

           SET TCODE=$PIECE(^AUTTIMM(TEST,0),U,3)

 +6        IF TSTRING=""

               SET TSTRING=TCODE

 +7        IF TSTRING'=""

               SET TSTRING=TSTRING_","_TCODE

 +8       ;Call the forecaster code to return the data

 +9        DO IMMFORC^BIRPC(.BPXSTR,DFN)

 +10       FOR I=1:1

               SET BPXFOR=$PIECE(BPXSTR,"^",I)

               IF BPXFOR=""

                   QUIT 

               Begin DoDot:1

 +11               SET BPXIMM=$PIECE(BPXFOR,"|",1)

 +12      ;See if the immunization is due

 +13               IF BPXIMM[TNAME

                       SET BPXDONE=1

 +14      ;Find the date last done

 +15               SET DATE=$$LASTIMM^BIUTL11(DFN,TSTRING)

               End DoDot:1

 +16       QUIT BPXDONE