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

BGOVMSR.m

Go to the documentation of this file. 
  1. BGOVMSR ; IHS/BAO/TMD - Manage V MEASUREMENTs ;17-Oct-2013 13:57;DU
  1.  ;;1.1;BGO COMPONENTS;**1,3,13**;Mar 20, 2007
  1.  ; Return most recent vitals
  1.  ;  INP = Patient IEN ^ Vital Types ^ Visit IEN
  1.  ; .RET = List of records of format:
  1.  ;        Type Name [1] ^ Value [2] ^ Date/Time [3] ^ V File IEN [4] ^ Visit IEN [5]
  1. LAST(RET,INP) ;EP
  1.  N DFN,TYPE,TYPESET,VIEN,CNT,TYPENM,IDT,IEN,X,DAT,FND,VSIT
  1.  K RET
  1.  S DFN=+INP
  1.  I 'DFN S RET(1)=$$ERR^BGOUTL(1050) Q
  1.  S TYPESET=$P(INP,U,2)
  1.  S:'$L(TYPESET) TYPESET="HT;WT;TMP;BP;PU;RS;PA"
  1.  S TYPESET=";"_TYPESET_";"
  1.  S VIEN=$P(INP,U,3)
  1.  S (TYPE,CNT)=0
  1.  F  S TYPE=$O(^AUPNVMSR("AA",DFN,TYPE)) Q:'TYPE  D
  1.  .S TYPENM=$P($G(^AUTTMSR(TYPE,0)),U)
  1.  .Q:TYPENM=""
  1.  .Q:TYPESET'[(";"_TYPENM_";")
  1.  .S (FND,IDT)=0
  1.  .F  S IDT=$O(^AUPNVMSR("AA",DFN,TYPE,IDT)) Q:'IDT  D  Q:FND
  1.  ..S IEN=0
  1.  ..F  S IEN=$O(^AUPNVMSR("AA",DFN,TYPE,IDT,IEN)) Q:'IEN  D  Q:FND
  1.  ...S X=$G(^AUPNVMSR(IEN,0)),DAT=+$G(^(12))
  1.  ...S VSIT=+$P(X,U,3)
  1.  ...I VIEN,VSIT'=VIEN Q
  1.  ...S:'DAT DAT=+$G(^AUPNVSIT(VSIT,0))
  1.  ...S CNT=CNT+1,FND=1
  1.  ...S RET(CNT)=TYPENM_U_$P(X,U,4)_U_$$CDT(DAT)_U_IEN_U_VSIT_U_$$ISLOCKED^BEHOENCX(VSIT)
  1.  Q
  1.  ; Returns vital measurements for current visit context in a single string
  1. TIUSTR() ;EP
  1.  N X,Y
  1.  S X=$$GETVAR^CIANBUTL("ENCOUNTER.ID.ALTERNATEVISITID",,"CONTEXT.ENCOUNTER")
  1.  I X="" Q " "
  1.  S X=$$VSTR2VIS^BEHOENCX(DFN,X)
  1.  I X<1 Q " "
  1.  D GET(.X,X_"^1")
  1.  Q $G(X)
  1.  ;
  1.  ; Return vital measurements for a visit
  1.  ;  INP = Visit IEN ^ Format (0=multiline, 1=single string)
  1.  ;  Returned as:
  1.  ;   Single line format: concatenated string of measurement results
  1.  ;   Multiple line format:
  1.  ;     Type Name [1] ^ Value [2] ^ Date [3] ^ VFile IEN [4] ^ Visit IEN [5] ^
  1.  ;     Encounter Provider Name [6] ^ Visit Locked [7]
  1. GET(RET,INP) ; EP
  1.  N VIEN,VFIEN,CNT,FORMAT
  1.  K RET
  1.  S VIEN=+INP
  1.  I 'VIEN S RET(1)=$$ERR^BGOUTL(1002) Q
  1.  S FORMAT=$P(INP,U,2)
  1.  S (VFIEN,CNT)=0
  1.  F  S VFIEN=$O(^AUPNVMSR("AD",VIEN,VFIEN)) Q:'VFIEN  D
  1.  .N X,USR,DAT,TYPE,TYPENM
  1.  .S X=$G(^AUPNVMSR(VFIEN,0)),DAT=+$G(^(12)),USR=+$P($G(^(12)),U,4)
  1.  .Q:X=""
  1.  .S TYPE=+X
  1.  .S TYPENM=$P($G(^AUTTMSR(TYPE,0)),U)
  1.  .Q:TYPENM=""
  1.  .S CNT=CNT+1
  1.  .I FORMAT D
  1.  ..N MSRSTR
  1.  ..S MSRSTR=TYPENM_":"_$P(X,U,4)
  1.  ..I TYPENM="WT" S MSRSTR=MSRSTR_" ("_($P(X,U,4)*.45359\1)_" kg)"
  1.  ..I TYPENM="HT" S MSRSTR=MSRSTR_" ("_($P(X,U,4)*2.54\1)_" cm)"
  1.  ..I TYPENM="TMP" S MSRSTR=MSRSTR_" ("_(((10*($P(X,U,4)-32/1.8))\1)/10)_" C)"
  1.  ..S RET(1)=$S(CNT=1:"",1:RET(1)_", ")_MSRSTR
  1.  .E  D
  1.  ..N NAME
  1.  ..S NAME=$P($G(^VA(200,USR,0)),U)
  1.  ..S:'DAT DAT=+$G(^AUPNVSIT(VIEN,0))
  1.  ..S RET(CNT)=TYPENM_U_$P(X,U,4)_U_$$CDT(DAT)_U_VFIEN_U_$P(X,U,3)_U_NAME_U_$$ISLOCKED^BEHOENCX(VIEN)
  1.  Q
  1.  ; Format date for display
  1. CDT(X) N Y,TM
  1.  Q:'X ""
  1.  S Y=$$FMTDATE^BGOUTL(X)
  1.  S TM=X#1*10000\1
  1.  Q:'TM Y
  1.  S TM=TM+10000
  1.  Q Y_"@"_$E(TM,2,3)_":"_$E(TM,4,5)
  1.  ; Return list of vital types
  1.  ; Return format:
  1.  ;  IEN [1] ^ Abbreviation [2] ^ Name [3] ^ Code [4]
  1. GETTYPES(RET,DUMMY) ;EP
  1.  N NAME,CODE,ABBR,REC,CNT,IEN
  1.  K RET
  1.  S (IEN,CNT)=0
  1.  F  S IEN=$O(^AUTTMSR(IEN)) Q:'IEN  D
  1.  .S REC=$G(^AUTTMSR(IEN,0))
  1.  .Q:REC=""
  1.  .Q:$P(REC,U,4)
  1.  .S ABBR=$P(REC,U)
  1.  .S NAME=$P(REC,U,2)
  1.  .Q:NAME["INACTIVE"
  1.  .S CODE=$P(REC,U,3)
  1.  .S CNT=CNT+1
  1.  .S RET(CNT)=IEN_U_ABBR_U_NAME_U_CODE
  1.  Q
  1.  ; Add/edit V Measurement entry
  1.  ;  INP = Visit IEN [1] ^ V File IEN [2] ^ Type [3] ^ Value [4] ^ Date/Time [5]
  1. SET(RET,INP) ;EP
  1.  N VIEN,TYPE,VFIEN,VFNEW,VAL,DAT,FDA,FNUM
  1.  S FNUM=$$FNUM
  1.  S VIEN=+INP
  1.  S RET=$$CHKVISIT^BGOUTL(VIEN)
  1.  Q:RET
  1.  S VFIEN=$P(INP,U,2)
  1.  I VFIEN,$P($G(^AUPNVMSR(VFIEN,12)),U,4),$P(^(12),U,4)'=DUZ S RET=$$ERR^BGOUTL(1086,$P($G(^VA(200,$P(^(12),U,4),0)),U)) Q
  1.  S VFNEW='VFIEN
  1.  S TYPE=$P(INP,U,3)
  1.  S:TYPE'=+TYPE TYPE=$O(^AUTTMSR("B",TYPE,0))
  1.  I 'TYPE S RET=$$ERR^BGOUTL(1087) Q
  1.  S VAL=$P(INP,U,4)
  1.  S DAT=$$CVTDATE^BGOUTL($P(INP,U,5))
  1.  I 'VFIEN D  Q:'VFIEN
  1.  .N FLDS
  1.  .S FLDS(.04)=VAL
  1.  .D VFNEW^BGOUTL2(.RET,FNUM,TYPE,VIEN,,.FLDS)
  1.  .S:RET>0 VFIEN=RET,RET=""
  1.  S FDA=$NA(FDA(FNUM,VFIEN_","))
  1.  S @FDA@(.01)="`"_TYPE
  1.  S @FDA@(.04)=VAL
  1.  I VFNEW D
  1.  .S @FDA@(1216)="N"
  1.  .S @FDA@(1217)="`"_DUZ
  1.  S @FDA@(1218)="N"
  1.  S @FDA@(1219)="`"_DUZ
  1.  S @FDA@(1201)=$S(DAT:DAT,1:"N")
  1.  S @FDA@(.07)=$S(DAT:DAT,1:"N")
  1.  S @FDA@(1204)="`"_DUZ
  1.  S @FDA@(.08)="`"_DUZ
  1.  S RET=$$UPDATE^BGOUTL(.FDA,"E")
  1.  I RET,VFNEW,$$DELETE^BGOUTL(FNUM,VFIEN)
  1.  D:'RET VFEVT^BGOUTL2(FNUM,VFIEN,'VFNEW)
  1.  S:'RET RET=VFIEN
  1.  Q
  1.  ; Delete a V Measurement entry
  1. DEL(RET,VFIEN) ;EP
  1.  D VFDEL^BGOUTL2(.RET,$$FNUM,VFIEN)
  1.  Q
  1.  ; Return V File #
  1. FNUM() Q 9000010.01