- 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 Feb 19, 2025@00:10:44 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 ;