BQI11P2.m

BQI11P2 ;VNGT/HS/ALA - Post Install for Patch 2 ; 20 Aug 2008  3:29 PM

 ;;1.1;ICARE MANAGEMENT SYSTEM;**2**;Jun 17, 2008

 ;

EN ;  Set up TaskMan to reset clean up immunization data

 NEW ZTDESC,ZTRTN,ZTIO,JBNOW,ZTDTH,ZTSK

 S ZTDESC="ICARE CLEAN UP IMMUN",ZTRTN="CLN^BQI11P2",ZTIO=""

 S JBNOW=$$NOW^XLFDT()

 S ZTDTH=$$FMADD^XLFDT(JBNOW,,,3)

 D ^%ZTLOAD

 Q

 ;

CLN ; Clean up immunization entries in BQIPAT

 NEW DFN,DA,DIK,RMDR,IEN,BQIUPD

 S RMDR="AUTTIMM"

 F  S RMDR=$O(^BQI(90506.1,"B",RMDR)) Q:RMDR=""!($P(RMDR,"_",1)'="AUTTIMM")  D

 . S IEN=""

 . F  S IEN=$O(^BQI(90506.1,"B",RMDR,IEN)) Q:IEN=""  D

 .. S BQIUPD(90506.1,IEN_",",.1)=1

 .. I $P(^BQI(90506.1,IEN,0),U,11)="" S BQIUPD(90506.1,IEN_",",.11)=$$DT^XLFDT()

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

 ;

 S DFN=0

 F  S DFN=$O(^BQIPAT(DFN)) Q:'DFN  D

 . S DA(1)=DFN,DIK="^BQIPAT("_DA(1)_",40,"

 . S RMDR="AUTTIMM"

 . F  S RMDR=$O(^BQIPAT(DFN,40,"B",RMDR)) Q:RMDR=""!($E(RMDR,1,7)'="AUTTIMM")  D

 .. S DA=""

 .. F  S DA=$O(^BQIPAT(DFN,40,"B",RMDR,DA)) Q:DA=""  D ^DIK

 ;

 D ^BQISCHED

 Q

BQI11P2   ;VNGT/HS/ALA - Post Install for Patch 2 ; 20 Aug 2008  3:29 PM

 +1       ;;1.1;ICARE MANAGEMENT SYSTEM;**2**;Jun 17, 2008

 +2       ;

EN        ;  Set up TaskMan to reset clean up immunization data

 +1        NEW ZTDESC,ZTRTN,ZTIO,JBNOW,ZTDTH,ZTSK

 +2        SET ZTDESC="ICARE CLEAN UP IMMUN"

           SET ZTRTN="CLN^BQI11P2"

           SET ZTIO=""

 +3        SET JBNOW=$$NOW^XLFDT()

 +4        SET ZTDTH=$$FMADD^XLFDT(JBNOW,,,3)

 +5        DO ^%ZTLOAD

 +6        QUIT 

 +7       ;

CLN       ; Clean up immunization entries in BQIPAT

 +1        NEW DFN,DA,DIK,RMDR,IEN,BQIUPD

 +2        SET RMDR="AUTTIMM"

 +3        FOR 

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

               IF RMDR=""!($PIECE(RMDR,"_",1)'="AUTTIMM")

                   QUIT 

               Begin DoDot:1

 +4                SET IEN=""

 +5                FOR 

                       SET IEN=$ORDER(^BQI(90506.1,"B",RMDR,IEN))

                       IF IEN=""

                           QUIT 

                       Begin DoDot:2

 +6                        SET BQIUPD(90506.1,IEN_",",.1)=1

 +7                        IF $PIECE(^BQI(90506.1,IEN,0),U,11)=""

                               SET BQIUPD(90506.1,IEN_",",.11)=$$DT^XLFDT()

                       End DoDot:2

               End DoDot:1

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

 +9       ;

 +10       SET DFN=0

 +11       FOR 

               SET DFN=$ORDER(^BQIPAT(DFN))

               IF 'DFN

                   QUIT 

               Begin DoDot:1

 +12               SET DA(1)=DFN

                   SET DIK="^BQIPAT("_DA(1)_",40,"

 +13               SET RMDR="AUTTIMM"

 +14               FOR 

                       SET RMDR=$ORDER(^BQIPAT(DFN,40,"B",RMDR))

                       IF RMDR=""!($EXTRACT(RMDR,1,7)'="AUTTIMM")

                           QUIT 

                       Begin DoDot:2

 +15                       SET DA=""

 +16                       FOR 

                               SET DA=$ORDER(^BQIPAT(DFN,40,"B",RMDR,DA))

                               IF DA=""

                                   QUIT 

                               DO ^DIK

                       End DoDot:2

               End DoDot:1

 +17      ;

 +18       DO ^BQISCHED

 +19       QUIT