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