BQITASK4.m

BQITASK4 ;GDIT/HS/ALA-Update a diagnostic tag ; 29 Jan 2014  8:37 AM

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

 ;

 ;

EN(TAG) ; EP

 NEW BQTN,BQDEF,BQEXEC,BQPRG,BQREF,BQGLB,PRGM,IEN,DFN

 S UID=$J

 S BQTN=$O(^BQI(90506.2,"B",TAG,"")) I BQTN="" Q

 I $$GET1^DIQ(90506.2,BQTN_",",.03,"I") Q

 I $$GET1^DIQ(90506.2,BQTN_",",.05,"I")=1 Q

 S BQDEF=$$GET1^DIQ(90506.2,BQTN_",",.01,"E")

 S BQEXEC=$$GET1^DIQ(90506.2,BQTN_",",1,"E")

 S BQPRG=$$GET1^DIQ(90506.2,BQTN_",",.04,"E")

 ;

 ; Set the taxonomy array from the file definition

 S BQREF="BQIRY" K @BQREF

 D ARY^BQITUTL(BQDEF,BQREF)

 S BQGLB=$NA(^TMP("BQIPOP",UID))

 K @BQGLB

 ;

 ; Call the populate category code

 S PRGM="POP^"_BQPRG_"(BQREF,BQGLB)"

 D @PRGM

 ;

 ; Check if patient tagged but not found in criteria anymore

 S IEN=""

 F  S IEN=$O(^BQIREG("B",BQTN,IEN)) Q:IEN=""  D

 . S DFN=$P(^BQIREG(IEN,0),U,2)

 . I '$D(@BQGLB@(DFN)) D

 .. D NCR^BQITDUTL(DFN,BQTN)

 .. ; Remove previous criteria

 .. NEW DA,DIK

 .. S DA(2)=DFN,DA(1)=BQTN,DA=0,DIK="^BQIPAT("_DA(2)_",20,"_DA(1)_",1,"

 .. F  S DA=$O(^BQIPAT(DFN,20,BQTN,1,DA)) Q:'DA  D ^DIK

 ; File the patients who met criteria

 S DFN=0

 F  S DFN=$O(@BQGLB@(DFN)) Q:DFN=""  D FIL^BQITASK(BQGLB,DFN)

 ;

 K @BQGLB,AGE,BQEXEC,BQDEF,BQPRG,@BQREF,BQREF,BQGLB,DFN,PRGM

 K SEX,TXDXCN,TXDXCT,TXT,Y,UID

 Q

 ;

JB ; EP - Task off job to update Pregnancy tag

 NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD

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

 S ZTDESC="Update Pregnancy Tag",ZTIO=""

 S ZTRTN="EN^BQITASK4(""Pregnant"")"

 D ^%ZTLOAD

 Q

 ;

JBAD ;EP - Task off job to update all diagnostic tags

 NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD

 S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,10)

 S ZTDESC="Update Diagnostic Tags",ZTIO=""

 S ZTRTN="DXC^BQITASK2"

 D ^%ZTLOAD

 Q

BQITASK4  ;GDIT/HS/ALA-Update a diagnostic tag ; 29 Jan 2014  8:37 AM

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

 +2       ;

 +3       ;

EN(TAG)   ; EP

 +1        NEW BQTN,BQDEF,BQEXEC,BQPRG,BQREF,BQGLB,PRGM,IEN,DFN

 +2        SET UID=$JOB

 +3        SET BQTN=$ORDER(^BQI(90506.2,"B",TAG,""))

           IF BQTN=""

               QUIT 

 +4        IF $$GET1^DIQ(90506.2,BQTN_",",.03,"I")

               QUIT 

 +5        IF $$GET1^DIQ(90506.2,BQTN_",",.05,"I")=1

               QUIT 

 +6        SET BQDEF=$$GET1^DIQ(90506.2,BQTN_",",.01,"E")

 +7        SET BQEXEC=$$GET1^DIQ(90506.2,BQTN_",",1,"E")

 +8        SET BQPRG=$$GET1^DIQ(90506.2,BQTN_",",.04,"E")

 +9       ;

 +10      ; Set the taxonomy array from the file definition

 +11       SET BQREF="BQIRY"

           KILL @BQREF

 +12       DO ARY^BQITUTL(BQDEF,BQREF)

 +13       SET BQGLB=$NAME(^TMP("BQIPOP",UID))

 +14       KILL @BQGLB

 +15      ;

 +16      ; Call the populate category code

 +17       SET PRGM="POP^"_BQPRG_"(BQREF,BQGLB)"

 +18       DO @PRGM

 +19      ;

 +20      ; Check if patient tagged but not found in criteria anymore

 +21       SET IEN=""

 +22       FOR 

               SET IEN=$ORDER(^BQIREG("B",BQTN,IEN))

               IF IEN=""

                   QUIT 

               Begin DoDot:1

 +23               SET DFN=$PIECE(^BQIREG(IEN,0),U,2)

 +24               IF '$DATA(@BQGLB@(DFN))

                       Begin DoDot:2

 +25                       DO NCR^BQITDUTL(DFN,BQTN)

 +26      ; Remove previous criteria

 +27                       NEW DA,DIK

 +28                       SET DA(2)=DFN

                           SET DA(1)=BQTN

                           SET DA=0

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

 +29                       FOR 

                               SET DA=$ORDER(^BQIPAT(DFN,20,BQTN,1,DA))

                               IF 'DA

                                   QUIT 

                               DO ^DIK

                       End DoDot:2

               End DoDot:1

 +30      ; File the patients who met criteria

 +31       SET DFN=0

 +32       FOR 

               SET DFN=$ORDER(@BQGLB@(DFN))

               IF DFN=""

                   QUIT 

               DO FIL^BQITASK(BQGLB,DFN)

 +33      ;

 +34       KILL @BQGLB,AGE,BQEXEC,BQDEF,BQPRG,@BQREF,BQREF,BQGLB,DFN,PRGM

 +35       KILL SEX,TXDXCN,TXDXCT,TXT,Y,UID

 +36       QUIT 

 +37      ;

JB        ; EP - Task off job to update Pregnancy tag

 +1        NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD

 +2        SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,3)

 +3        SET ZTDESC="Update Pregnancy Tag"

           SET ZTIO=""

 +4        SET ZTRTN="EN^BQITASK4(""Pregnant"")"

 +5        DO ^%ZTLOAD

 +6        QUIT 

 +7       ;

JBAD      ;EP - Task off job to update all diagnostic tags

 +1        NEW ZTDTH,ZTDESC,ZTRTN,ZTIO,ZTSAVE,BQIUPD

 +2        SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT(),,,10)

 +3        SET ZTDESC="Update Diagnostic Tags"

           SET ZTIO=""

 +4        SET ZTRTN="DXC^BQITASK2"

 +5        DO ^%ZTLOAD

 +6        QUIT