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

BQIMUVFL.m

Go to the documentation of this file. 
  1. BQIMUVFL ;VNGT/HS/BEE-MU Retrieve V UPDATED/REVIEWED information ; 17 Dec 2010  9:03 AM
  1.  ;;2.2;ICARE MANAGEMENT SYSTEM;;Jul 28, 2011;Build 37
  1.  ;
  1.  ;
  1. EN(DATA,DFN,ACTION) ;EP -- BQI GET VFILE INFO
  1.  ;
  1.  ;Returns V UPDATED/REVIEWED file information
  1.  ;
  1.  ;Input:
  1.  ; DFN - Patient IEN
  1.  ; ACTION - NULL - Return most recent information for all CLINICAL REVIEW ACTIONS
  1.  ;        - Unique CLINICAL ACTION ENTRY - Return just the most recent information for that entry
  1.  ;        - ALLERGY - Returns the most recent information for Allergy-related CLINICAL REVIEW ACTIONS
  1.  ;        - PROBLEM LIST - Returns the most recent information for Problem List-related CLINICAL REVIEW ACTIONS
  1.  ;        - MEDICATION - Returns the most recent information for Medication-related CLINICAL REVIEW ACTIONS
  1.  ;        
  1.  NEW UID,II,HDR,ACT,IEN,CACT
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIMUVFL",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUVFL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S HDR="T00045ACTION^D00015DATE^T00030ENCOUNTER_PROVIDER"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;
  1.  ; Set up listing of ACTIONs to return
  1.  S:ACTION="ALLERGY" ACTION="ALLERG"
  1.  S:ACTION="PROBLEM LIST" ACTION="PROBLEM"
  1.  D
  1.  . I ACTION="ALLERG"!(ACTION="PROBLEM")!(ACTION="MEDICATION") D  Q
  1.  .. S ACT=0 F  S ACT=$O(^AUTTCRA(ACT)) Q:'ACT  S CACT=$G(^AUTTCRA(ACT,0)) I $P(CACT,U)[ACTION,$P(CACT,U,2)]"" S ACT($P(CACT,U,2))=$P(CACT,U)
  1.  . I ACTION]"" D  Q
  1.  .. S ACT=$O(^AUTTCRA("B",ACTION,"")) I ACT]"" S CACT=$G(^AUTTCRA(ACT,0)) I $P(CACT,U,2)]"" S ACT($P(CACT,U,2))=ACTION
  1.  . S ACT=0 F  S ACT=$O(^AUTTCRA(ACT)) Q:'ACT  S CACT=$G(^AUTTCRA(ACT,0)) I $P(CACT,U,2)]"" S ACT($P(CACT,U,2))=$P(CACT,U)
  1.  ;
  1.  ; Loop through desired list and pull entries
  1.  S ACT="" F  S ACT=$O(ACT(ACT)) Q:ACT=""  I $T(@ACT)]"" D @(ACT_"("_DFN_")")
  1.  ;
  1. DONE S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. RPBL(DATA,DFN,ACTION) ;EP -- BQI GET MU PRB INFO
  1.  ;
  1.  ;Returns Problem List MU individual information for a particular patient
  1.  ;
  1.  ;Input:
  1.  ; DFN - Patient IEN
  1.  ; ACTION - PROBLEM LIST REVIEWED/PROBLEM LIST UPDATED/NO ACTIVE PROBLEMS
  1.  ;        
  1.  NEW UID,II,HDR,ACT,IEN,CACT,CALL
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BQIMUVFL",UID))
  1.  K @DATA
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BQIMUVFL D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
  1.  S HDR="I00010DFN^T00045ACTION^D00030APCDTCDT^T00035APCDTEPR"
  1.  S @DATA@(II)=HDR_$C(30)
  1.  ;
  1.  S CALL=""
  1.  S ACT=$O(^AUTTCRA("B",ACTION,"")) I ACT]"" S CACT=$G(^AUTTCRA(ACT,0)) I $P(CACT,U,2)]"" S CALL="P"_$P(CACT,U,2)
  1.  ;
  1.  ;If defined, call tag
  1.  I CALL]"",$T(@CALL)]"" D @(CALL_"("_DFN_")")
  1.  ;
  1. XRPBL S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. PLR(DFN) ;EP-Retrieve PROBLEM LIST REVIEWED info
  1.  ;
  1.  ;Input:
  1.  ; II - Index entry
  1.  ; DATA - Array to store info
  1.  ;Output:
  1.  ; @DATA = CLINICAL ACTION^DATE OF OCCURRANCE^ENTERED BY
  1.  ;
  1.  N RSLT
  1.  S RSLT=$$LASTPLR^APCLAPI6(DFN,,DT,"A") Q:RSLT=""
  1.  D WRT(RSLT)
  1.  Q
  1.  ;
  1. PLU(DFN) ;EP-Retrieve PROBLEM LIST UPDATED info
  1.  ;
  1.  ;Input:
  1.  ; II - Index entry
  1.  ; DATA - Array to store info
  1.  ;Output:
  1.  ; @DATA = CLINICAL ACTION^DATE OF OCCURRANCE^ENTERED BY
  1.  ;
  1.  N RSLT
  1.  S RSLT=$$LASTPLU^APCLAPI6(DFN,,DT,"A") Q:RSLT=""
  1.  D WRT(RSLT)
  1.  Q
  1.  ;
  1. NAP(DFN) ;EP-Retrieve NO ACTIVE PROBLEMS info
  1.  ;
  1.  ;Input:
  1.  ; II - Index entry
  1.  ; DATA - Array to store info
  1.  ;Output:
  1.  ; @DATA = CLINICAL ACTION^DATE OF OCCURRANCE^ENTERED BY
  1.  ;
  1.  N RSLT
  1.  S RSLT=$$LASTNAP^APCLAPI6(DFN,,DT,"A") Q:RSLT=""
  1.  D WRT(RSLT)
  1.  Q
  1.  ;
  1. PPLR(DFN) ;EP-Retrieve PROBLEM LIST REVIEWED info
  1.  ;
  1.  ;Input:
  1.  ; II - Index entry
  1.  ; DATA - Array to store info
  1.  ;Output:
  1.  ; @DATA = CLINICAL ACTION^DATE OF OCCURRANCE^ENTERED BY
  1.  ;
  1.  N RSLT
  1.  S RSLT=$$LASTPLR^APCLAPI6(DFN,,DT,"A") Q:RSLT=""
  1.  D PWRT(RSLT,DFN)
  1.  Q
  1.  ;
  1. PPLU(DFN) ;EP-Retrieve PROBLEM LIST UPDATED info
  1.  ;
  1.  ;Input:
  1.  ; II - Index entry
  1.  ; DATA - Array to store info
  1.  ;Output:
  1.  ; @DATA = CLINICAL ACTION^DATE OF OCCURRANCE^ENTERED BY
  1.  ;
  1.  N RSLT
  1.  S RSLT=$$LASTPLU^APCLAPI6(DFN,,DT,"A") Q:RSLT=""
  1.  D PWRT(RSLT,DFN)
  1.  Q
  1.  ;
  1. PNAP(DFN) ;EP-Retrieve NO ACTIVE PROBLEMS info
  1.  ;
  1.  ;Input:
  1.  ; II - Index entry
  1.  ; DATA - Array to store info
  1.  ;Output:
  1.  ; @DATA = CLINICAL ACTION^DATE OF OCCURRANCE^ENTERED BY
  1.  ;
  1.  N RSLT
  1.  S RSLT=$$LASTNAP^APCLAPI6(DFN,,DT,"A") Q:RSLT=""
  1.  D PWRT(RSLT,DFN)
  1.  Q
  1.  ;
  1. MLR(DFN) ;EP-Retrieve MEDICATION LIST REVIEWED info
  1.  ;
  1.  ;Input:
  1.  ; II - Index entry
  1.  ; DATA - Array to store info
  1.  ;Output:
  1.  ; @DATA = CLINICAL ACTION^DATE OF OCCURRANCE^ENTERED BY
  1.  ;
  1.  N RSLT
  1.  S RSLT=$$LASTMLR^APCLAPI6(DFN,,DT,"A") Q:RSLT=""
  1.  D WRT(RSLT)
  1.  Q
  1.  ;
  1. MLU(DFN) ;EP-Retrieve MEDICATION LIST UPDATED info
  1.  ;
  1.  ;Input:
  1.  ; II - Index entry
  1.  ; DATA - Array to store info
  1.  ;Output:
  1.  ; @DATA = CLINICAL ACTION^DATE OF OCCURRANCE^ENTERED BY
  1.  ;
  1.  N RSLT
  1.  S RSLT=$$LASTMLU^APCLAPI6(DFN,,DT,"A") Q:RSLT=""
  1.  D WRT(RSLT)
  1.  Q
  1.  ;
  1. NAM(DFN) ;EP-Retrieve NO ACTIVE MEDICATIONS info
  1.  ;
  1.  ;Input:
  1.  ; II - Index entry
  1.  ; DATA - Array to store info
  1.  ;Output:
  1.  ; @DATA = CLINICAL ACTION^DATE OF OCCURRANCE^ENTERED BY
  1.  ;
  1.  N RSLT
  1.  S RSLT=$$LASTNAM^APCLAPI6(DFN,,DT,"A") Q:RSLT=""
  1.  D WRT(RSLT)
  1.  Q
  1.  ;
  1. ALR(DFN) ;EP-Retrieve ALLERGY LIST REVIEWED info
  1.  ;
  1.  ;Input:
  1.  ; II - Index entry
  1.  ; DATA - Array to store info
  1.  ;Output:
  1.  ; @DATA = CLINICAL ACTION^DATE OF OCCURRANCE^ENTERED BY
  1.  ;
  1.  N RSLT
  1.  S RSLT=$$LASTALR^APCLAPI6(DFN,,DT,"A") Q:RSLT=""
  1.  D WRT(RSLT)
  1.  Q
  1.  ;
  1. ALU(DFN) ;EP-Retrieve ALLERGY LIST UPDATED info
  1.  ;
  1.  ;Input:
  1.  ; II - Index entry
  1.  ; DATA - Array to store info
  1.  ;Output:
  1.  ; @DATA = CLINICAL ACTION^DATE OF OCCURRANCE^ENTERED BY
  1.  ;
  1.  N RSLT
  1.  S RSLT=$$LASTALU^APCLAPI6(DFN,,DT,"A") Q:RSLT=""
  1.  D WRT(RSLT)
  1.  Q
  1.  ;
  1. NAA(DFN) ;EP-Retrieve NO ACTIVE ALLERGIES info
  1.  ;
  1.  ;Input:
  1.  ; II - Index entry
  1.  ; DATA - Array to store info
  1.  ;Output:
  1.  ; @DATA = CLINICAL ACTION^DATE OF OCCURRANCE^ENTERED BY
  1.  ;
  1.  N RSLT
  1.  S RSLT=$$LASTNAA^APCLAPI6(DFN,,DT,"A") Q:RSLT=""
  1.  D WRT(RSLT)
  1.  Q
  1.  ;
  1. FRMT(X) ;EP-Format output for BQI GET VFILE INFO
  1.  N RSLT
  1.  Q:X="" ""
  1.  ;
  1.  ;Pull time from entry if not defined (current API doesnt return time)
  1.  I $P($P(X,U),".",2)="" D
  1.  . N IEN,DTM
  1.  . S IEN=$P(X,U,6) Q:IEN=""
  1.  . S DTM=$$GET1^DIQ(9000010.54,IEN_",",1201,"I")
  1.  . S:DTM["." $P(X,U)=DTM
  1.  ;
  1.  S RSLT=$P(X,U,2)_U_$$FMTE^BQIUL1($P(X,U))_U_$$GET1^DIQ(200,$P(X,U,3)_",",.01,"E")
  1.  Q RSLT
  1.  ;
  1. WRT(RSLT) ;EP-Write output string to Global Array for BQI GET VFILE INFO
  1.  S RSLT=$$FRMT(RSLT)
  1.  S II=II+1,@DATA@(II)=RSLT_$C(30)
  1.  Q
  1.  ;
  1. PFRMT(X,DFN) ;EP-Format output for BQI GET MU PRB INFO
  1.  N RSLT
  1.  Q:X="" ""
  1.  ;
  1.  ;Check for time in result - Pull from file if blank (current API doesn't include time)
  1.  I $P($P(X,U),".",2)="" D
  1.  . N IEN,DTM
  1.  . S IEN=$P(X,U,6) Q:IEN=""
  1.  . S DTM=$$GET1^DIQ(9000010.54,IEN_",",1201,"I")
  1.  . S:DTM["." $P(X,U)=DTM
  1.  ;
  1.  S RSLT=DFN_U_$P(X,U,2)_U_$$FMTE^BQIUL1($P(X,U))_U_$P(X,U,3)_$C(28)_$$GET1^DIQ(200,$P(X,U,3)_",",.01,"E")
  1.  Q RSLT
  1.  ;
  1. PWRT(RSLT,DFN) ;EP-Write output string to Global Array for BQI GET MU PRB INFO
  1.  S RSLT=$$PFRMT(RSLT,DFN)
  1.  S II=II+1,@DATA@(II)=RSLT_$C(30)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S BMXSEC="Recording that an error occurred at "_ERRDTM
  1.  I $D(II),$D(DATA) S II=II+1,@DATA@(II)=$C(31)
  1.  Q