BQIRMDR2.m

BQIRMDR2 ;GDHS/HCD/ALA-Forecaster Reminders ; 05 Feb 2016  3:28 PM

 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72

 ;

 ;

IFR ; EP - Immunization Forecaster

 S BQIUPD(90508,"1,",4.19)=$$NOW^XLFDT()

 D FILE^DIE("","BQIUPD","ERROR")

 D PTLS^BQIRMIZ

 S BQIUPD(90508,"1,",4.2)=$$NOW^XLFDT()

 D FILE^DIE("","BQIUPD","ERROR")

 NEW RCAT,RCLIN,IN,IMM,TEXT,CODE,HDR,RIEN

 S RCAT="IZ Forecaster",RCLIN="Immunizations"

 I $G(SOURCE)="" S SOURCE="Reminders"

 S IMM=""

 F  S IMM=$O(^BIPDUE("C",IMM)) Q:IMM=""  D

 . ;S IMM=$P(^BIPDUE(IMN,0),"^",2)

 . ; if forecast was not updated with active patients logic in PTLS, quit

 . ;I $P(^BIPDUE(IMN,0),"^",6)<DT Q

 . ; If not enabled for forecaster, quit

 . I $P(^BITN(IMM,0),U,16)=1 Q

 . S TEXT=$P(^BITN(IMM,0),U,2)

 . S CODE="IZ_"_TEXT

 . S HDR="T00050"_CODE

 . S RIEN="",RIEN=$O(^BQI(90506.1,"B",CODE,RIEN))

 . I RIEN'="" D  Q

 .. I $P(^BQI(90506.1,RIEN,0),"^",10)="" Q

 .. D REA^BQIRMDR1

 . D FILE^BQIRMDR

 Q

 ;

IZ(DFN) ;EP

 NEW VALUE,FRN,IMN,RCDUE,OVDUE

 S FRN=""

 F  S FRN=$O(^BIPDUE("B",DFN,FRN)) Q:FRN=""  D

 . S (REMDUE,REMLAST,REMNEXT)=""

 . S IMN=$P($G(^BIPDUE(FRN,0)),"^",2) I IMN="" Q

 . S RCDUE=$P(^BIPDUE(FRN,0),"^",4),OVDUE=$P(^(0),"^",5)

 . S REMDUE=$S(RCDUE'="":RCDUE,1:OVDUE)

 . S REMLAST=$$LIMM^BQIREM(DFN,IMN) I REMLAST'="" S REMLAST=$P(REMLAST,"^",1)

 . S CODE="IZ_"_$P(^BITN(IMN,0),U,2)

 . D FIL^BQIRMDR

 Q

BQIRMDR2  ;GDHS/HCD/ALA-Forecaster Reminders ; 05 Feb 2016  3:28 PM

 +1       ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72

 +2       ;

 +3       ;

IFR       ; EP - Immunization Forecaster

 +1        SET BQIUPD(90508,"1,",4.19)=$$NOW^XLFDT()

 +2        DO FILE^DIE("","BQIUPD","ERROR")

 +3        DO PTLS^BQIRMIZ

 +4        SET BQIUPD(90508,"1,",4.2)=$$NOW^XLFDT()

 +5        DO FILE^DIE("","BQIUPD","ERROR")

 +6        NEW RCAT,RCLIN,IN,IMM,TEXT,CODE,HDR,RIEN

 +7        SET RCAT="IZ Forecaster"

           SET RCLIN="Immunizations"

 +8        IF $GET(SOURCE)=""

               SET SOURCE="Reminders"

 +9        SET IMM=""

 +10       FOR 

               SET IMM=$ORDER(^BIPDUE("C",IMM))

               IF IMM=""

                   QUIT 

               Begin DoDot:1

 +11      ;S IMM=$P(^BIPDUE(IMN,0),"^",2)

 +12      ; if forecast was not updated with active patients logic in PTLS, quit

 +13      ;I $P(^BIPDUE(IMN,0),"^",6)<DT Q

 +14      ; If not enabled for forecaster, quit

 +15               IF $PIECE(^BITN(IMM,0),U,16)=1

                       QUIT 

 +16               SET TEXT=$PIECE(^BITN(IMM,0),U,2)

 +17               SET CODE="IZ_"_TEXT

 +18               SET HDR="T00050"_CODE

 +19               SET RIEN=""

                   SET RIEN=$ORDER(^BQI(90506.1,"B",CODE,RIEN))

 +20               IF RIEN'=""

                       Begin DoDot:2

 +21                       IF $PIECE(^BQI(90506.1,RIEN,0),"^",10)=""

                               QUIT 

 +22                       DO REA^BQIRMDR1

                       End DoDot:2

                       QUIT 

 +23               DO FILE^BQIRMDR

               End DoDot:1

 +24       QUIT 

 +25      ;

IZ(DFN)   ;EP

 +1        NEW VALUE,FRN,IMN,RCDUE,OVDUE

 +2        SET FRN=""

 +3        FOR 

               SET FRN=$ORDER(^BIPDUE("B",DFN,FRN))

               IF FRN=""

                   QUIT 

               Begin DoDot:1

 +4                SET (REMDUE,REMLAST,REMNEXT)=""

 +5                SET IMN=$PIECE($GET(^BIPDUE(FRN,0)),"^",2)

                   IF IMN=""

                       QUIT 

 +6                SET RCDUE=$PIECE(^BIPDUE(FRN,0),"^",4)

                   SET OVDUE=$PIECE(^(0),"^",5)

 +7                SET REMDUE=$SELECT(RCDUE'="":RCDUE,1:OVDUE)

 +8                SET REMLAST=$$LIMM^BQIREM(DFN,IMN)

                   IF REMLAST'=""

                       SET REMLAST=$PIECE(REMLAST,"^",1)

 +9                SET CODE="IZ_"_$PIECE(^BITN(IMN,0),U,2)

 +10               DO FIL^BQIRMDR

               End DoDot:1

 +11       QUIT