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