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

BQITRPHS.m

Go to the documentation of this file.
  1. BQITRPHS ;APTIV/HC/ALA-Treatment Prompt API for Health Summary ; 28 Feb 2008 3:31 PM
  1. ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1. ;
  1. EN(BQIDFN,BQIHSM,ARRAY) ; PEP - by patient and each best practice prompt
  1. ; Input
  1. ; BQIDFN - Patient IEN
  1. ; BQIHSM - Treatment Prompt text from File #9001018
  1. ; this should match with a category in 90508.5
  1. ; ARRAY - Reference that data should be returned in
  1. ;
  1. ; Get the category IEN
  1. NEW IEN,BQTCT,BQTIEN,BQIDXN,CSTAT,BQIRMK,UID,BK,CT,RESULT
  1. S BQTIEN=$$FIND1^DIC(90508.5,"","BX",BQIHSM,"","","ERROR")
  1. ;
  1. K ARRAY
  1. S CT=0
  1. S BQIDXN=$$GET1^DIQ(90508.5,BQTIEN_",",.02,"E")
  1. I '$$ATAG^BQITDUTL(BQIDFN,BQIDXN) Q
  1. ;
  1. K BQIRMK
  1. S BK=0,UID=$J
  1. F S BK=$O(^BQI(90508.5,BQTIEN,1,BK)) Q:'BK S BQIRMK(BK)=^BQI(90508.5,BQTIEN,1,BK,0)
  1. I '$$FND^BQITRPPT(BQTIEN,"BQITEST",BQIDFN,.BQIRMK) Q
  1. S ARRAY(0)=1_U_"Patient's active iCare Diagnostic Tag is "_BQIDXN
  1. S CT=CT+1
  1. M ARRAY=BQIRMK
  1. Q
  1. ;
  1. APCH ; EP - Tag to be called from Health Summary
  1. NEW APCHSTAT,BQITXT,APCHSCT,APCHSGHR,APCHSL
  1. Q:'$$INAC^APCHSMU(APCHSITI)
  1. ; Not a candidate
  1. Q:'$$CVT(APCHSPAT)
  1. S APCHLAST="",APCHNEXT="" K APCHSTEX
  1. I $G(APCHCOLW)="" S APCHCOLW=10
  1. S BQITXT=$P(^APCHSURV(APCHSITI,0),U,1)
  1. D EN(APCHSPAT,BQITXT,.APCHSTEX)
  1. K ^UTILITY($J,"W")
  1. NEW DIWL,DIWR,BQI,X
  1. S DIWR=40,DIWL=1
  1. F BQI=1:1 Q:'$D(APCHSTEX(BQI)) D
  1. . S X=APCHSTEX(BQI)
  1. . D ^DIWP
  1. K APCHSTEX
  1. S X=0 F S X=$O(^UTILITY($J,"W",DIWL,X)) Q:X'=+X S APCHSTEX(X)=^UTILITY($J,"W",DIWL,X,0)
  1. D WRITETP
  1. K ^UTILITY($J,"W")
  1. Q
  1. ;
  1. PAT(DFN,ARRAY) ;PEP - By patient and get all best practice prompts
  1. NEW TAG,BQTN,ORD,CT,BQTIEN,BQIRMK,BDT,BI,BK,BN,E,EDT,LCNT,NDESC,PDESC,RES,RESULT,TXT,VSDTM,X
  1. K ARRAY
  1. S TAG=$$CVT(DFN)
  1. I 'TAG S ARRAY(0)="Patient does not have an iCare Diagnostic Tag of CVD" Q
  1. S ARRAY(0)=1_U_"Patient's active iCare Diagnostic Tag is "_$P(TAG,U,2)
  1. I $O(^BQIPAT(DFN,50,0))="" S ARRAY(1)="No CVD Best Practice Prompts on file for this patient."
  1. S BQTIEN=0,CT=0
  1. F S BQTIEN=$O(^BQIPAT(DFN,50,BQTIEN)) Q:'BQTIEN D
  1. . S BN=0,CT=CT+1
  1. . M ARRAY(CT)=^BQIPAT(DFN,50,BQTIEN,1)
  1. Q
  1. ;
  1. CVT(DFN) ;EP - Is patient tagged for CVD?
  1. S RESULT=0
  1. S TXT="CVD"
  1. F S TXT=$O(^BQI(90506.2,"B",TXT)) Q:TXT=""!($E(TXT,1,3)'="CVD") D
  1. . I '$$ATAG^BQITDUTL(DFN,TXT) Q
  1. . S RESULT=1_U_TXT_U_$O(^BQI(90506.2,"B",TXT,""))
  1. Q RESULT
  1. ;
  1. WRITETP ;EP - write out TP
  1. I $G(APCHSGHR) D Q
  1. .NEW A,B
  1. .S (A,B)=0
  1. .S APCHRVAL(0)="1^"_$P(^APCHSURV(APCHSITI,0),U)
  1. .F S B=$O(APCHSTEX(B)) Q:B'=+B S A=A+1,APCHRVAL(A)=APCHSTEX(B)
  1. I 'APCHSANY D FIRST^APCHSTP Q:$D(APCHSQIT) S APCHSANY=1,APCHSNPG=0
  1. X APCHSCKP Q:$D(APCHSQIT)
  1. I APCHSNPG S APCHSCT=0,APCHSNPG=0
  1. S APCHX=$S($P(^APCHSURV(APCHSITI,0),U,4)]"":$P(^APCHSURV(APCHSITI,0),U,4),1:$P(^APCHSURV(APCHSITI,0),U))
  1. I $D(APCHSTEX)>1 W APCHX,!
  1. I '$D(APCHSTEX) Q
  1. ;I $L(APCHX)>28 W !
  1. F APCHSL=1:1 Q:'$D(APCHSTEX(APCHSL))!($D(APCHSQIT)) D
  1. .X APCHSCKP Q:$D(APCHSQIT)
  1. .W ?30,APCHSTEX(APCHSL),!
  1. K APCHSTEX
  1. Q