| 1 | VBECA5A ;DALOI/BNT/RLM - BLOOD PRODUCT LOOKUP FOR SURGERY ;08/23/2001
|
|---|
| 2 | ;;0.5;VBECS;**288**;APR 26, 2002
|
|---|
| 3 | ; Reference to IX^DIC supported by DBIA #10006
|
|---|
| 4 | ; Reference to LIST^DIC supported by DBIA #2051
|
|---|
| 5 | ; Reference to ^DIR supported by DBIA #10026
|
|---|
| 6 | ;
|
|---|
| 7 | ITRAN ; -- Input Transform lookup
|
|---|
| 8 | N DIC,DA,Y,Z,D,DIE,DO,DICR,Q,DR
|
|---|
| 9 | S DIC="^LAB(66,",DIC(0)="EQSZ"
|
|---|
| 10 | S DIC("S")="I $P(^(0),U,15)"
|
|---|
| 11 | S D="B" D IX^DIC
|
|---|
| 12 | K DIQUIET,VBDIC
|
|---|
| 13 | I $D(DTOUT)!($D(DUOUT)) K X Q
|
|---|
| 14 | S X=$G(Y(0,0)) K:X="" X
|
|---|
| 15 | I $G(Y)'=-1 S VBECSEL=+Y
|
|---|
| 16 | Q
|
|---|
| 17 | DIR ;
|
|---|
| 18 | N DIC,DA,Y,Z,D,DIE,DO,DICR,DIR
|
|---|
| 19 | S DIC="^LAB(66,",DIC(0)="EQ",D="B"
|
|---|
| 20 | D IX^DIC
|
|---|
| 21 | Q
|
|---|
| 22 | OUT66 ;
|
|---|
| 23 | K ERROR,DIERR,VBECO
|
|---|
| 24 | D LIST^DIC(66,,.01,,,,,,"I $P(^(0),U,15)",,"VBECO","ERROR")
|
|---|
| 25 | S VBEC=0 F VBECL=1:1 S VBEC=$O(VBECO("DILIST",1,VBEC)) Q:'VBEC D Q:$D(DUOUT)!$D(DTOUT)
|
|---|
| 26 | . W !,VBECO("DILIST",1,VBEC)
|
|---|
| 27 | . I '(VBECL#5) S DIR(0)="E" D ^DIR
|
|---|
| 28 | K VBEC,VBECL,VBECO
|
|---|
| 29 | Q
|
|---|
| 30 | LIST66 ;
|
|---|
| 31 | N D,DO,DIC,X
|
|---|
| 32 | K ^TMP("DILIST",$J),VBECO
|
|---|
| 33 | S X="?",DIC="^LAB(66,",DIC(0)="EQS",D="B"
|
|---|
| 34 | S DIC("S")="I $P(^(0),U,15)"
|
|---|
| 35 | D IX^DIC
|
|---|
| 36 | K DIBTDH
|
|---|
| 37 | Q
|
|---|
