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

BQIUL1.m

Go to the documentation of this file. 
  1. BQIUL1 ;PRXM/HC/DLS - Miscellaneous BQI Utilities ; 26 Oct 2005  9:43 AM
  1.  ;;2.4;ICARE MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 10
  1.  ;
  1.  Q
  1.  ;
  1. FMTE(Y) ;EP - Convert Fileman Date/Time to 'MMM DD, CCYY HH:MM:SS' format.
  1.  ;Description
  1.  ;  Receives Date (Y) in FileMan format and returns formatted date.
  1.  ;
  1.  ;Input
  1.  ;  Y - FileMan date/time (i.e. 3051024.123456).
  1.  ;  
  1.  ;Output
  1.  ;  Date/Time in External format (i.e. OCT 24,2005 12:34:56).
  1.  ;  
  1.  NEW DATM,XX,I,V
  1.  S DATM=$TR($$FMTE^DILIBF(Y,"5U"),"@"," ")
  1.  I DATM["24:00" S DATM=$P(DATM," ",1,2)_" 00:00"
  1.  S XX="" F I=1:1:$L(DATM) S V=$E(DATM,I,I),XX=XX_V I V="," S XX=XX_" "
  1.  S DATM=XX
  1.  Q DATM
  1.  ;
  1. DATE(DATE) ;EP - Convert standard date/time to a FileMan date/time
  1.  ;Input
  1.  ;  DATE - In a standard format
  1.  ;Output
  1.  ;  -1 is if it couldn't convert to a FileMan date
  1.  ;  otherwise a standard FileMan date
  1.  NEW %DT,X,Y
  1.  I DATE[":" D
  1.  . I DATE["/",$L(DATE," ")=3 S DATE=$P(DATE," ",1)_"@"_$P(DATE," ",2)_$P(DATE," ",3) Q
  1.  . I $L(DATE," ")=3 S DATE=$P(DATE," ",1,2)_"@"_$P(DATE," ",3)
  1.  . I $L(DATE," ")>3 S DATE=$P(DATE," ",1,3)_"@"_$P(DATE," ",4,99)
  1.  S %DT="TS",X=DATE D ^%DT
  1.  I Y=-1 S Y=""
  1.  ;
  1.  Q Y
  1.  ;
  1. FMTMDY(DATE) ;EP - Convert fileman date to MM/DD/YYYY format
  1.  ;Input
  1.  ;  DATE - In fileman format
  1.  ;  
  1.  ;Output
  1.  ;  -1 if couldn't convert to MM/DD/YYYY format
  1.  ;  Otherwise, date in MM/DD/YYYY format
  1.  ;
  1.  Q $TR($$FMTE^XLFDT(DATE,"5Z"),"@"," ")
  1.  ;
  1. TKO(STR,VAL) ;EP - Take off ending character
  1.  ;
  1.  ;Description
  1.  ;  This will take off the ending character at the end of
  1.  ;  a string
  1.  ;Input
  1.  ;  STR - String of data
  1.  ;  VAL - Delimiter character
  1.  ;Output
  1.  ;  same STR without the ending character
  1.  ;
  1.  I $G(STR)="" Q ""
  1.  I $G(VAL)="" Q ""
  1.  ;
  1.  NEW LV
  1.  S LV=$L(VAL)
  1.  I $E(STR,$L(STR)-(LV-1),$L(STR))=VAL S STR=$E(STR,1,$L(STR)-LV)
  1.  ;
  1.  Q STR
  1.  ;
  1. STRIP(STR,VAL) ;EP - Remove one or more trailing characters in a string.
  1.  ;
  1.  ;Description
  1.  ;  Removes one or more trailing characters
  1.  ;  at the end of a string.
  1.  ;Input
  1.  ;  STR - String of data
  1.  ;  VAL - Delimiter character
  1.  ;Output
  1.  ;  Same STR without the trailing character(s).
  1.  ;
  1.  I $G(STR)="" Q STR
  1.  I $G(VAL)="" Q STR
  1.  ;
  1.  F  Q:$E(STR,$L(STR))'=VAL  S STR=$E(STR,1,($L(STR)-1))
  1.  Q STR
  1.  ;
  1. CTRL(X) ;EP - Strip out control characters
  1.  I X'?.ANP F Y=1:1 I $E(X,Y)?.C Q:Y>$L(X)!(X="")  S X=$E(X,1,Y-1)_$E(X,Y+1,999),Y=Y-1
  1.  Q X
  1.  ;
  1. TRIM(STR,VAL) ;EP - Remove one or more leading characters in a string.
  1.  ;
  1.  ;Description
  1.  ;  Removes one or more leading characters from a string.
  1.  ;Input
  1.  ;  STR - String of data
  1.  ;  VAL - Delimiter character
  1.  ;Output
  1.  ;  Same STR without the trailing character(s).
  1.  ;
  1.  I $G(STR)="" Q STR
  1.  I $G(VAL)="" Q STR
  1.  ;
  1.  F  Q:$E(STR,1)'=VAL  S STR=$E(STR,2,($L(STR)))
  1.  Q STR
  1.  ;
  1. TMPFL(MODE,UID,DFN) ;EP - Open to 'R'ead, Open to 'W'rite, 'C'lose or 'D'elete
  1.  ; temporary file designed for use when converting report text to RPC
  1.  ; data strings. Note that UID and DFN are components of the file name.
  1.  ;
  1.  ; Input
  1.  ;    MODE(Required) - 'R'(Read),'W'(Write),'C'(Close),'D'(Delete)
  1.  ;    UID(Req'd for modes D,R,W) - Job identifier
  1.  ;    DFN(Req'd for modes D,R,W) - Patient IEN
  1.  ; Output
  1.  ;    POP - 0 for success, 1 for failure
  1.  ;    
  1.  N POP,HSPATH,HSFN
  1.  S POP=1
  1.  ;
  1.  ; To close a file.
  1.  I MODE="C" D CLOSE^%ZISH("BQIFILE")
  1.  ;
  1.  ; To Delete, Read-From, or Write-To a file.
  1.  I "D/R/W"[MODE D
  1.  .S HSPATH=$$DEFDIR^%ZISH("")
  1.  .I HSPATH="" S HSPATH=$$PWD^%ZISH()
  1.  .S HSFN=UID_"_"_$G(DFN)_".DAT"
  1.  ;
  1.  ; To delete a file
  1.  I MODE="D" S POP=$$DEL^%ZISH(HSPATH,HSFN)
  1.  ;
  1.  ; To Read from or to Write to a file.
  1.  I (MODE="R")!(MODE="W") D
  1.  .D OPEN^%ZISH("BQIFILE",HSPATH,HSFN,MODE)
  1.  Q POP
  1.  ;
  1. CMSI(X) ;EP - CMS Register Lookup
  1.  NEW DIC
  1.  S DIC(0)=$S($G(X)="":"AENZ",1:"NZ")
  1.  S DIC="^ACM(41.1," D ^DIC
  1.  S X=$P(Y,U,2) K:+Y<0 X
  1.  Q
  1.  ;
  1. PRV(VIEN) ;EP - Get PRIMARY provider for a visit
  1.  NEW PRV
  1.  S PRV=$$PRIMVPRV^PXUTL1(VIEN)
  1.  I PRV=0 S PRV=$$PROV(VIEN)
  1.  I PRV=0 Q ""
  1.  Q $$GET1^DIQ(200,PRV_",",.01,"E")
  1.  ;
  1. VVNAR(VIEN) ;EP - Get visit POV narratives
  1.  NEW IEN,POVN,TEXT,CT
  1.  S TEXT="",CT=0,IEN=""
  1.  F  S IEN=$O(^AUPNVPOV("AD",VIEN,IEN)) Q:IEN=""  D
  1.  . S POVN=$$GET1^DIQ(9000010.07,IEN_",",".019","E")
  1.  . I $L(TEXT)+$L(POVN)>250 Q
  1.  . S CT=CT+1
  1.  . S TEXT=TEXT_CT_")"_POVN_";"_$C(13)_$C(10)
  1.  Q $$TKO^BQIUL1(TEXT,";"_$C(13)_$C(10))
  1.  ;
  1. VPNAR(VIEN) ;EP - Get visit provider narratives
  1.  NEW IEN,PRVN,TEXT,CT
  1.  S TEXT="",CT=0,IEN=""
  1.  F  S IEN=$O(^AUPNVPOV("AD",VIEN,IEN)) Q:IEN=""  D
  1.  . S PRVN=$$GET1^DIQ(9000010.07,IEN_",",".04","E")
  1.  . I $L(TEXT)+$L(PRVN)>250 Q
  1.  . S CT=CT+1
  1.  . S TEXT=TEXT_CT_")"_PRVN_";"_$C(13)_$C(10)
  1.  Q $$TKO^BQIUL1(TEXT,";"_$C(13)_$C(10))
  1.  ;
  1. PROB(PIEN) ; EP - Return date/time from Problem
  1.  ;  Input Parameter
  1.  ;    PIEN = IEN of problem
  1.  ;
  1.  ;Since not all dates exist or are not required data entry, the
  1.  ;hierachy is 'DATE ENTERED', and then 'DATE LAST MODIFIED'.
  1.  NEW VISDTM
  1.  ; DATE ENTERED
  1.  S VISDTM=$$GET1^DIQ(9000011,PIEN,.08,"I")
  1.  ; if for some reason DATE ENTERED doesn't exist, look at DATE LAST MODIFIED.
  1.  I VISDTM="" S VISDTM=$$GET1^DIQ(9000011,PIEN,.03,"I")
  1.  Q VISDTM
  1.  ;
  1. PROV(VIEN) ;EP - Check for Hospital Primary Provider
  1.  NEW DGADM,MIEN,PROV
  1.  S PROV=0
  1.  S DGADM=$O(^DGPM("AVISIT",VIEN,""))
  1.  I DGADM="" Q ""
  1.  S MIEN="",QFL=0
  1.  F  S MIEN=$O(^DGPM("CA",DGADM,MIEN),-1) Q:MIEN=""!(QFL)  D
  1.  . S PROV=$$GET1^DIQ(405,MIEN_",",.08,"I") I PROV>0 S QFL=1
  1.  Q PROV
  1.  ;
  1. HRN(BQIDFN) ;EP - Find any active HRNs for a patient
  1.  NEW HRN,FLAG,SITE
  1.  S FLAG=0,SITE=0
  1.  F  S SITE=$O(^AUPNPAT(BQIDFN,41,SITE)) Q:'SITE  D  Q:FLAG
  1.  . I $P($G(^AUPNPAT(BQIDFN,41,SITE,0)),U,3)="" S FLAG=1
  1.  Q FLAG
  1.  ;
  1. VTHR(BQIDFN) ; EP - Find any visits in last 3 years for patient
  1.  NEW FLAG,BDATE,RVDATE,VIEN,RVSDTM,VSDTM,QFL
  1.  S FLAG=0,VIEN="",QFL=0,VSDTM=""
  1.  S BDATE=$$DATE("T-36M"),RVDATE=9999999-BDATE
  1.  S RVSDTM=$O(^AUPNVSIT("AA",BQIDFN,RVDATE),-1)
  1.  I RVSDTM'="" D
  1.  . F  S VIEN=$O(^AUPNVSIT("AA",BQIDFN,RVSDTM,VIEN)) Q:VIEN=""  D  Q:QFL
  1.  .. I $G(^AUPNVSIT(VIEN,0))="" Q
  1.  .. S FLAG=1,QFL=1
  1.  .. S VSDTM=$P($G(^AUPNVSIT(VIEN,0)),U,1)
  1.  Q FLAG_U_VIEN_U_VSDTM
  1.  ;
  1. VTWR(BQIDFN) ; EP - Find any visits in the last 2 years for patient
  1.  NEW FLAG,BDATE,RVDATE,VIEN,RVSDTM,VSDTM,QFL
  1.  S FLAG=0,VIEN="",QFL=0,VSDTM=""
  1.  S BDATE=$$DATE("T-24M"),RVDATE=9999999-BDATE
  1.  S RVSDTM=$O(^AUPNVSIT("AA",BQIDFN,RVDATE),-1)
  1.  I RVSDTM'="" D
  1.  . F  S VIEN=$O(^AUPNVSIT("AA",BQIDFN,RVSDTM,VIEN)) Q:VIEN=""  D  Q:QFL
  1.  .. I $G(^AUPNVSIT(VIEN,0))="" Q
  1.  .. S FLAG=1,QFL=1
  1.  .. S VSDTM=$P($G(^AUPNVSIT(VIEN,0)),U,1)
  1.  Q FLAG_U_VIEN_U_VSDTM