BQITRUPD.m

BQITRUPD ;GDIT/HS/ALA-Update Treatment Prompts ; 30 May 2014  3:09 PM

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

 ;

 ;

CBP ; Update CVD Best Practice Prompts for Health Summary

 NEW BQTIEN,NAME,AIEN,BQIUPD,INACT

 I $O(^APCHSURV("A"),-1)'=$P(^APCHSURV(0),U,3) S $P(^APCHSURV(0),U,3)=$O(^APCHSURV("A"),-1)

 S BQTIEN=0

BP S BQTIEN=$O(^BQI(90508.5,BQTIEN)) Q:'BQTIEN

 S NAME=$P(^BQI(90508.5,BQTIEN,0),U,1),INACT=$P(^(0),U,4)

 S AIEN=$$FIND1^DIC(9001018,"","BX",NAME,"","","ERROR")

 ; If it does not exist and is inactive, go to next one

 I 'AIEN,INACT G BP

 ; If it exists and is inactive, set it to "deleted"

 I AIEN,INACT S BQIUPD(9001018,AIEN_",",.03)="D"

 I 'AIEN D ADD

 D WP^DIE(9001018,AIEN_",",2,"","^BQI(90508.5,BQTIEN,3)")

 D WP^DIE(9001018,AIEN_",",1300,"","^BQI(90508.5,BQTIEN,4)")

 G BP

 ;

ADD ;EP

 NEW DIC,DLAYGO,X

 S DIC="^APCHSURV(",DLAYGO=9001018,DIC("P")=DLAYGO,X=NAME,DIC(0)="L"

 K DO,DD D FILE^DICN

 S AIEN=+Y

 S BQIUPD(9001018,AIEN_",",.03)=1

 S BQIUPD(9001018,AIEN_",",.07)="T"

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

 S BQIUPD(9001018,AIEN_",",.05)="CVD-RELATED"

 S BQIUPD(9001018,AIEN_",",1)="APCH;BQITRPHS"

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

 Q

 ;

NON(NAME,TEXT) ;Non tag specific BP update

 NEW AIEN

 S AIEN=$$FIND1^DIC(9001018,"","BX",NAME,"","","ERROR")

 I 'AIEN D ADD

 D WP^DIE(9001018,AIEN_",",1200,"","TEXT")

 S BQIUPD(9001018,AIEN_",",1)="APCH;BQITRASM"

 S BQIUPD(9001018,AIEN_",",.06)=1

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

 Q

 ;

DESC(NAME,TEXT) ; Update description

 NEW AIEN

 S AIEN=$$FIND1^DIC(9001018,"","BX",NAME,"","","ERROR")

 I 'AIEN Q

 D WP^DIE(9001018,AIEN_",",2,"","TEXT")

 Q

BQITRUPD  ;GDIT/HS/ALA-Update Treatment Prompts ; 30 May 2014  3:09 PM

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

 +2       ;

 +3       ;

CBP       ; Update CVD Best Practice Prompts for Health Summary

 +1        NEW BQTIEN,NAME,AIEN,BQIUPD,INACT

 +2        IF $ORDER(^APCHSURV("A"),-1)'=$PIECE(^APCHSURV(0),U,3)

               SET $PIECE(^APCHSURV(0),U,3)=$ORDER(^APCHSURV("A"),-1)

 +3        SET BQTIEN=0

BP         SET BQTIEN=$ORDER(^BQI(90508.5,BQTIEN))

           IF 'BQTIEN

               QUIT 

 +1        SET NAME=$PIECE(^BQI(90508.5,BQTIEN,0),U,1)

           SET INACT=$PIECE(^(0),U,4)

 +2        SET AIEN=$$FIND1^DIC(9001018,"","BX",NAME,"","","ERROR")

 +3       ; If it does not exist and is inactive, go to next one

 +4        IF 'AIEN

               IF INACT

                   GOTO BP

 +5       ; If it exists and is inactive, set it to "deleted"

 +6        IF AIEN

               IF INACT

                   SET BQIUPD(9001018,AIEN_",",.03)="D"

 +7        IF 'AIEN

               DO ADD

 +8        DO WP^DIE(9001018,AIEN_",",2,"","^BQI(90508.5,BQTIEN,3)")

 +9        DO WP^DIE(9001018,AIEN_",",1300,"","^BQI(90508.5,BQTIEN,4)")

 +10       GOTO BP

 +11      ;

ADD       ;EP

 +1        NEW DIC,DLAYGO,X

 +2        SET DIC="^APCHSURV("

           SET DLAYGO=9001018

           SET DIC("P")=DLAYGO

           SET X=NAME

           SET DIC(0)="L"

 +3        KILL DO,DD

           DO FILE^DICN

 +4        SET AIEN=+Y

 +5        SET BQIUPD(9001018,AIEN_",",.03)=1

 +6        SET BQIUPD(9001018,AIEN_",",.07)="T"

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

 +8        SET BQIUPD(9001018,AIEN_",",.05)="CVD-RELATED"

 +9        SET BQIUPD(9001018,AIEN_",",1)="APCH;BQITRPHS"

 +10       DO FILE^DIE("E","BQIUPD","ERROR")

 +11       QUIT 

 +12      ;

NON(NAME,TEXT) ;Non tag specific BP update

 +1        NEW AIEN

 +2        SET AIEN=$$FIND1^DIC(9001018,"","BX",NAME,"","","ERROR")

 +3        IF 'AIEN

               DO ADD

 +4        DO WP^DIE(9001018,AIEN_",",1200,"","TEXT")

 +5        SET BQIUPD(9001018,AIEN_",",1)="APCH;BQITRASM"

 +6        SET BQIUPD(9001018,AIEN_",",.06)=1

 +7        DO FILE^DIE("E","BQIUPD","ERROR")

 +8        QUIT 

 +9       ;

DESC(NAME,TEXT) ; Update description

 +1        NEW AIEN

 +2        SET AIEN=$$FIND1^DIC(9001018,"","BX",NAME,"","","ERROR")

 +3        IF 'AIEN

               QUIT 

 +4        DO WP^DIE(9001018,AIEN_",",2,"","TEXT")

 +5        QUIT