VBECA5A.m

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 ---VBECA5A   1961     printed  Apr 09, 2024@21:46:23                                                                                                                                                                                                     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