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

VBECDCX1.m

Go to the documentation of this file.
  1. VBECDCX1 ;hoifo/gjc-data conversion & pre-implementation data extract;Nov 21, 2002
  1. ;;2.0;VBEC;;Jun 05, 2015;Build 4
  1. ;
  1. ;Medical Device #:
  1. ;Note: The food and Drug Administration classifies this software as a
  1. ;medical device. As such, it may not be changed in any way.
  1. ;Modifications to this software may result in an adulterated medical
  1. ;device under 21CFR820, the use of which is considered to be a
  1. ;violation of US Federal Statutes. Acquiring and implementing this
  1. ;software through the Freedom of Information Act requires the
  1. ;implementer to assume total responsibility for the software, and
  1. ;become a registered manufacturer of a medical device, subject to FDA
  1. ;regulations.
  1. ;
  1. ANTIAB ;save off totals of ANTIBODIES IDENTIFIED, ANTIBODIES IDENTIFIED
  1. ;COMMENTS, RBC ANTIGENS PRESENT, RBC ANTIGENS PRESENT COMMENT,
  1. ;RBC ANTIGENS ABSENT, RBC ANTIGENS ABSENT COMMENT.
  1. ;total up the number of times antigens present/absent & antibodies
  1. ;identified appear in patient specific data
  1. I $P(LRD,U)'="" S $P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,LRPCE)=$P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,LRPCE)+1
  1. I $P(LRD,U,2)'="" D
  1. .S $P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,LRPCE+1)=$P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,LRPCE+1)+1 ;do comments exist?
  1. .;save # of comment chars
  1. .S $P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,LRPCE+2)=$P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,LRPCE+2)+$L($$STRIP^VBECDCX1($P(LRD,U,2)))
  1. .Q
  1. Q
  1. ;
  1. TRDTAB ;tabulate the number of transfusion date/time and transfusion reaction
  1. ;type records
  1. I $P(LRD,U)'="" S $P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,22)=$P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,22)+1
  1. I $P(LRD,U,2)'="" S $P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,23)=$P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,23)+1
  1. Q
  1. ;
  1. TRCMNT ;tabulate the number of transfusion comments and the total number of
  1. ;characters for all transfusion comments.
  1. ;LRTRCMT defined in TCTRC^VBECDCX
  1. S $P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,25)=$P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,25)+$L(LRTRCMT)
  1. Q
  1. ;
  1. BBC(DFN,LRDFN) ; extract 'BLOOD BANK COMMENTS' data from the legacy
  1. ; Blood Bank application. The first node will have the timestamp
  1. ; (date) of when the comments were most recently edited.
  1. ; Input: DFN=patient DFN
  1. ; LRDFN=lab patient ien in the Lab Data (#63) file
  1. S (LRD1,Z)=0,LRBBCDT=$P($G(^LR(LRDFN,3,0)),U,5)
  1. S LRBBCDT=$P(LRBBCDT,".") ;RLM 03/27/2007
  1. S:LRBBCDT'?7N LRBBCDT=-1 ;should be a date w/o time
  1. S:LRBBCDT'=-1 LRBBCDT=$$DATE^VBECDCU(LRBBCDT)
  1. S:LRBBCDT=-1 LRBBCDT="" ;RLM 03/27/2007
  1. F S LRD1=$O(^LR(LRDFN,3,LRD1)) Q:'LRD1 D
  1. .S LRD=$G(^LR(LRDFN,3,LRD1,0)) Q:LRD=""
  1. .;translate carets '^' to nulls
  1. .S LRD=$TR(LRD,"^","")
  1. .;strip leading spaces & trailing spaces
  1. .S LRD=$$STRIP(LRD),Z=Z+1
  1. .S LRSTR=LRDFN_U_DFN_U_LRD1_U_LRD_U_LRBBCDT
  1. .S:Z=1 $P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,26)=1
  1. .S $P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,27)=$P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,27)+$L(LRD)
  1. .S CNT=$$CNT^VBECDCU("VBEC63 BBC",$J)
  1. .S CNT=CNT+1,^TMP("VBEC63 BBC",$J,CNT,0)=LRSTR_$C(13)
  1. .S VBECTOT("VBEC63 BBC")=+$G(VBECTOT("VBEC63 BBC"))+1
  1. .;total BBC character count for ALL records.
  1. .S $P(^TMP("VBEC FINIS",$J,0),U,27)=+$P(^TMP("VBEC FINIS",$J,0),U,27)+$L(LRD)
  1. .;total up the number of instances Blood Bank Comments (BBC)
  1. .S:Z=1 $P(^TMP("VBEC FINIS",$J,0),U,26)=+$P(^TMP("VBEC FINIS",$J,0),U,26)+1
  1. .Q
  1. K CNT,I,LRBBCDT,LRD,LRD1,LRSTR,Z
  1. Q
  1. ;
  1. STRIP(X) ;strip leading and trailing spaces from a data string.
  1. ; input: string to be checked for leading and trailing spaces
  1. ;return: string without leading and trailing spaces
  1. ;strip leading spaces first...
  1. F Q:$F(X," ")'=2 S X=$E(X,2,$L(X))
  1. ;then strip trailing spaces...
  1. F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
  1. Q X
  1. ;