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