VBECA5A ;DALOI/BNT/RLM - BLOOD PRODUCT LOOKUP FOR SURGERY ;08/23/2001
;;2.0;VBEC;;Jun 05, 2015;Build 4
;
; Note: This routine supports data exchange with an FDA registered
; medical device. As such, it may not be changed in any way without
; prior written approval from the medical device manufacturer.
;
; Integration Agreements:
; Reference to IX^DIC supported by DBIA #10006
; Reference to LIST^DIC supported by DBIA #2051
; Reference to ^DIR supported by DBIA #10026
;
; ------------------------------------------------------
; Private method supports IA #3631
; ------------------------------------------------------
ITRAN ; -- Input Transform lookup
G COMPCL^VBECA5B ;Old code below for reference
N DIC,DA,Y,Z,D,DIE,DO,DICR,Q,DR
S DIC="^LAB(66,",DIC(0)="EQSZ"
S DIC("S")="I $P(^(0),U,15)"
S D="B" D IX^DIC
K DIQUIET,VBDIC
I $D(DTOUT)!($D(DUOUT)) K X Q
S X=$G(Y(0,0)) K:X="" X
I $G(Y)'=-1 S VBECSEL=+Y
Q
DIR ;I can't find a reference to this in the surgery code.
N DIC,DA,Y,Z,D,DIE,DO,DICR,DIR
S DIC="^LAB(66,",DIC(0)="EQ",D="B"
D IX^DIC
Q
;
; ------------------------------------------------------
; Private method supports IA #3631
; ------------------------------------------------------
OUT66 ;
G LIST^VBECA5B ;Old code below for reference
K ERROR,DIERR,VBECO
D LIST^DIC(66,,.01,,,,,,"I $P(^(0),U,15)",,"VBECO","ERROR")
S VBEC=0 F VBECL=1:1 S VBEC=$O(VBECO("DILIST",1,VBEC)) Q:'VBEC D Q:$D(DUOUT)!$D(DTOUT)
. W !,VBECO("DILIST",1,VBEC)
. I '(VBECL#5) S DIR(0)="E" D ^DIR
K VBEC,VBECL,VBECO
;
; ------------------------------------------------------
; Private method supports IA #3631
; ------------------------------------------------------
LIST66 ;
G LIST^VBECA5B ;Old code below for reference
N D,DO,DIC,X
K ^TMP("DILIST",$J),VBECO
S X="?",DIC="^LAB(66,",DIC(0)="EQS",D="B"
S DIC("S")="I $P(^(0),U,15)"
D IX^DIC
K DIBTDH
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECA5A 1961 printed Dec 13, 2024@02:43:49 Page 2
VBECA5A ;DALOI/BNT/RLM - BLOOD PRODUCT LOOKUP FOR SURGERY ;08/23/2001
+1 ;;2.0;VBEC;;Jun 05, 2015;Build 4
+2 ;
+3 ; Note: This routine supports data exchange with an FDA registered
+4 ; medical device. As such, it may not be changed in any way without
+5 ; prior written approval from the medical device manufacturer.
+6 ;
+7 ; Integration Agreements:
+8 ; Reference to IX^DIC supported by DBIA #10006
+9 ; Reference to LIST^DIC supported by DBIA #2051
+10 ; Reference to ^DIR supported by DBIA #10026
+11 ;
+12 ; ------------------------------------------------------
+13 ; Private method supports IA #3631
+14 ; ------------------------------------------------------
ITRAN ; -- Input Transform lookup
+1 ;Old code below for reference
GOTO COMPCL^VBECA5B
+2 NEW DIC,DA,Y,Z,D,DIE,DO,DICR,Q,DR
+3 SET DIC="^LAB(66,"
SET DIC(0)="EQSZ"
+4 SET DIC("S")="I $P(^(0),U,15)"
+5 SET D="B"
DO IX^DIC
+6 KILL DIQUIET,VBDIC
+7 IF $DATA(DTOUT)!($DATA(DUOUT))
KILL X
QUIT
+8 SET X=$GET(Y(0,0))
if X=""
KILL X
+9 IF $GET(Y)'=-1
SET VBECSEL=+Y
+10 QUIT
DIR ;I can't find a reference to this in the surgery code.
+1 NEW DIC,DA,Y,Z,D,DIE,DO,DICR,DIR
+2 SET DIC="^LAB(66,"
SET DIC(0)="EQ"
SET D="B"
+3 DO IX^DIC
+4 QUIT
+5 ;
+6 ; ------------------------------------------------------
+7 ; Private method supports IA #3631
+8 ; ------------------------------------------------------
OUT66 ;
+1 ;Old code below for reference
GOTO LIST^VBECA5B
+2 KILL ERROR,DIERR,VBECO
+3 DO LIST^DIC(66,,.01,,,,,,"I $P(^(0),U,15)",,"VBECO","ERROR")
+4 SET VBEC=0
FOR VBECL=1:1
SET VBEC=$ORDER(VBECO("DILIST",1,VBEC))
if 'VBEC
QUIT
Begin DoDot:1
+5 WRITE !,VBECO("DILIST",1,VBEC)
+6 IF '(VBECL#5)
SET DIR(0)="E"
DO ^DIR
End DoDot:1
if $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+7 KILL VBEC,VBECL,VBECO
+8 ;
+9 ; ------------------------------------------------------
+10 ; Private method supports IA #3631
+11 ; ------------------------------------------------------
LIST66 ;
+1 ;Old code below for reference
GOTO LIST^VBECA5B
+2 NEW D,DO,DIC,X
+3 KILL ^TMP("DILIST",$JOB),VBECO
+4 SET X="?"
SET DIC="^LAB(66,"
SET DIC(0)="EQS"
SET D="B"
+5 SET DIC("S")="I $P(^(0),U,15)"
+6 DO IX^DIC
+7 KILL DIBTDH
+8 QUIT
