VBECDCX1 ;hoifo/gjc-data conversion & pre-implementation data extract;Nov 21, 2002
;;2.0;VBEC;;Jun 05, 2015;Build 4
;
;Medical Device #:
;Note: The food and Drug Administration classifies this software as a
;medical device. As such, it may not be changed in any way.
;Modifications to this software may result in an adulterated medical
;device under 21CFR820, the use of which is considered to be a
;violation of US Federal Statutes. Acquiring and implementing this
;software through the Freedom of Information Act requires the
;implementer to assume total responsibility for the software, and
;become a registered manufacturer of a medical device, subject to FDA
;regulations.
;
ANTIAB ;save off totals of ANTIBODIES IDENTIFIED, ANTIBODIES IDENTIFIED
;COMMENTS, RBC ANTIGENS PRESENT, RBC ANTIGENS PRESENT COMMENT,
;RBC ANTIGENS ABSENT, RBC ANTIGENS ABSENT COMMENT.
;total up the number of times antigens present/absent & antibodies
;identified appear in patient specific data
I $P(LRD,U)'="" S $P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,LRPCE)=$P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,LRPCE)+1
I $P(LRD,U,2)'="" D
.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?
.;save # of comment chars
.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)))
.Q
Q
;
TRDTAB ;tabulate the number of transfusion date/time and transfusion reaction
;type records
I $P(LRD,U)'="" S $P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,22)=$P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,22)+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
Q
;
TRCMNT ;tabulate the number of transfusion comments and the total number of
;characters for all transfusion comments.
;LRTRCMT defined in TCTRC^VBECDCX
S $P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,25)=$P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,25)+$L(LRTRCMT)
Q
;
BBC(DFN,LRDFN) ; extract 'BLOOD BANK COMMENTS' data from the legacy
; Blood Bank application. The first node will have the timestamp
; (date) of when the comments were most recently edited.
; Input: DFN=patient DFN
; LRDFN=lab patient ien in the Lab Data (#63) file
S (LRD1,Z)=0,LRBBCDT=$P($G(^LR(LRDFN,3,0)),U,5)
S LRBBCDT=$P(LRBBCDT,".") ;RLM 03/27/2007
S:LRBBCDT'?7N LRBBCDT=-1 ;should be a date w/o time
S:LRBBCDT'=-1 LRBBCDT=$$DATE^VBECDCU(LRBBCDT)
S:LRBBCDT=-1 LRBBCDT="" ;RLM 03/27/2007
F S LRD1=$O(^LR(LRDFN,3,LRD1)) Q:'LRD1 D
.S LRD=$G(^LR(LRDFN,3,LRD1,0)) Q:LRD=""
.;translate carets '^' to nulls
.S LRD=$TR(LRD,"^","")
.;strip leading spaces & trailing spaces
.S LRD=$$STRIP(LRD),Z=Z+1
.S LRSTR=LRDFN_U_DFN_U_LRD1_U_LRD_U_LRBBCDT
.S:Z=1 $P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,26)=1
.S $P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,27)=$P(^TMP("VBEC FINIS",$J,VBECRTOT,0),U,27)+$L(LRD)
.S CNT=$$CNT^VBECDCU("VBEC63 BBC",$J)
.S CNT=CNT+1,^TMP("VBEC63 BBC",$J,CNT,0)=LRSTR_$C(13)
.S VBECTOT("VBEC63 BBC")=+$G(VBECTOT("VBEC63 BBC"))+1
.;total BBC character count for ALL records.
.S $P(^TMP("VBEC FINIS",$J,0),U,27)=+$P(^TMP("VBEC FINIS",$J,0),U,27)+$L(LRD)
.;total up the number of instances Blood Bank Comments (BBC)
.S:Z=1 $P(^TMP("VBEC FINIS",$J,0),U,26)=+$P(^TMP("VBEC FINIS",$J,0),U,26)+1
.Q
K CNT,I,LRBBCDT,LRD,LRD1,LRSTR,Z
Q
;
STRIP(X) ;strip leading and trailing spaces from a data string.
; input: string to be checked for leading and trailing spaces
;return: string without leading and trailing spaces
;strip leading spaces first...
F Q:$F(X," ")'=2 S X=$E(X,2,$L(X))
;then strip trailing spaces...
F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
Q X
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECDCX1 3771 printed Apr 09, 2024@21:45:55 Page 2
VBECDCX1 ;hoifo/gjc-data conversion & pre-implementation data extract;Nov 21, 2002
+1 ;;2.0;VBEC;;Jun 05, 2015;Build 4
+2 ;
+3 ;Medical Device #:
+4 ;Note: The food and Drug Administration classifies this software as a
+5 ;medical device. As such, it may not be changed in any way.
+6 ;Modifications to this software may result in an adulterated medical
+7 ;device under 21CFR820, the use of which is considered to be a
+8 ;violation of US Federal Statutes. Acquiring and implementing this
+9 ;software through the Freedom of Information Act requires the
+10 ;implementer to assume total responsibility for the software, and
+11 ;become a registered manufacturer of a medical device, subject to FDA
+12 ;regulations.
+13 ;
ANTIAB ;save off totals of ANTIBODIES IDENTIFIED, ANTIBODIES IDENTIFIED
+1 ;COMMENTS, RBC ANTIGENS PRESENT, RBC ANTIGENS PRESENT COMMENT,
+2 ;RBC ANTIGENS ABSENT, RBC ANTIGENS ABSENT COMMENT.
+3 ;total up the number of times antigens present/absent & antibodies
+4 ;identified appear in patient specific data
+5 IF $PIECE(LRD,U)'=""
SET $PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,LRPCE)=$PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,LRPCE)+1
+6 IF $PIECE(LRD,U,2)'=""
Begin DoDot:1
+7 ;do comments exist?
SET $PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,LRPCE+1)=$PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,LRPCE+1)+1
+8 ;save # of comment chars
+9 SET $PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,LRPCE+2)=$PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,LRPCE+2)+$LENGTH($$STRIP^VBECDCX1($PIECE(LRD,U,2)))
+10 QUIT
End DoDot:1
+11 QUIT
+12 ;
TRDTAB ;tabulate the number of transfusion date/time and transfusion reaction
+1 ;type records
+2 IF $PIECE(LRD,U)'=""
SET $PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,22)=$PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,22)+1
+3 IF $PIECE(LRD,U,2)'=""
SET $PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,23)=$PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,23)+1
+4 QUIT
+5 ;
TRCMNT ;tabulate the number of transfusion comments and the total number of
+1 ;characters for all transfusion comments.
+2 ;LRTRCMT defined in TCTRC^VBECDCX
+3 SET $PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,25)=$PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,25)+$LENGTH(LRTRCMT)
+4 QUIT
+5 ;
BBC(DFN,LRDFN) ; extract 'BLOOD BANK COMMENTS' data from the legacy
+1 ; Blood Bank application. The first node will have the timestamp
+2 ; (date) of when the comments were most recently edited.
+3 ; Input: DFN=patient DFN
+4 ; LRDFN=lab patient ien in the Lab Data (#63) file
+5 SET (LRD1,Z)=0
SET LRBBCDT=$PIECE($GET(^LR(LRDFN,3,0)),U,5)
+6 ;RLM 03/27/2007
SET LRBBCDT=$PIECE(LRBBCDT,".")
+7 ;should be a date w/o time
if LRBBCDT'?7N
SET LRBBCDT=-1
+8 if LRBBCDT'=-1
SET LRBBCDT=$$DATE^VBECDCU(LRBBCDT)
+9 ;RLM 03/27/2007
if LRBBCDT=-1
SET LRBBCDT=""
+10 FOR
SET LRD1=$ORDER(^LR(LRDFN,3,LRD1))
if 'LRD1
QUIT
Begin DoDot:1
+11 SET LRD=$GET(^LR(LRDFN,3,LRD1,0))
if LRD=""
QUIT
+12 ;translate carets '^' to nulls
+13 SET LRD=$TRANSLATE(LRD,"^","")
+14 ;strip leading spaces & trailing spaces
+15 SET LRD=$$STRIP(LRD)
SET Z=Z+1
+16 SET LRSTR=LRDFN_U_DFN_U_LRD1_U_LRD_U_LRBBCDT
+17 if Z=1
SET $PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,26)=1
+18 SET $PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,27)=$PIECE(^TMP("VBEC FINIS",$JOB,VBECRTOT,0),U,27)+$LENGTH(LRD)
+19 SET CNT=$$CNT^VBECDCU("VBEC63 BBC",$JOB)
+20 SET CNT=CNT+1
SET ^TMP("VBEC63 BBC",$JOB,CNT,0)=LRSTR_$CHAR(13)
+21 SET VBECTOT("VBEC63 BBC")=+$GET(VBECTOT("VBEC63 BBC"))+1
+22 ;total BBC character count for ALL records.
+23 SET $PIECE(^TMP("VBEC FINIS",$JOB,0),U,27)=+$PIECE(^TMP("VBEC FINIS",$JOB,0),U,27)+$LENGTH(LRD)
+24 ;total up the number of instances Blood Bank Comments (BBC)
+25 if Z=1
SET $PIECE(^TMP("VBEC FINIS",$JOB,0),U,26)=+$PIECE(^TMP("VBEC FINIS",$JOB,0),U,26)+1
+26 QUIT
End DoDot:1
+27 KILL CNT,I,LRBBCDT,LRD,LRD1,LRSTR,Z
+28 QUIT
+29 ;
STRIP(X) ;strip leading and trailing spaces from a data string.
+1 ; input: string to be checked for leading and trailing spaces
+2 ;return: string without leading and trailing spaces
+3 ;strip leading spaces first...
+4 FOR
if $FIND(X," ")'=2
QUIT
SET X=$EXTRACT(X,2,$LENGTH(X))
+5 ;then strip trailing spaces...
+6 FOR
if $EXTRACT(X,$LENGTH(X))'=" "
QUIT
SET X=$EXTRACT(X,1,($LENGTH(X)-1))
+7 QUIT X
+8 ;
