Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQITRUPD

BQITRUPD.m

Go to the documentation of this file.
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