LRBLJP.m

LRBLJP ;AVAMC/REG - BB INVENTORY PRINT OPTS ;3/9/94  13:03 ;

 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994

 ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021

S K DIC W ! S DIC=65,DIC(0)="AEFQM" D ^DIC G:X=""!(X[U) END S DIC="^LRD(65,",DA=+Y,DR="0:ZZ" D EN^DIQ G S

 ;

P W ! S DIC=65,DIC(0)="AEFQM",L=0 D ^DIC G:X=""!(X[U)!($A(X)=46) END S X=$P(Y,U,2),FLDS="[CAPTIONED]",BY="UNIT ID",(FR,TO)=X,DHD="Unit inquiry "_$$INS^LRU D EN1^DIP K DIC Q

 ;

T W !!?27,"TYPING CHARGE LIST",!! D EDC,LRSTAR G:Y<0 END S L=0,DIC="^LRD(65,",FLDS="[LRBLDSP]",BY="DATE/TIME RECEIVED,TYPING CHARGE",FR=LRSDT,TO=LRLDT K %ZIS D EN1^DIP K DIC Q

 ;

I D SET,EDC W @IOF,?27,"SUPPLIER INVOICE LIST",!! S L=0,DIC="^LRD(65,",(FLDS,BY)="[LRBLINV]",DHD="Blood inventory list "_$$INS^LRU K %ZIS D EN1^DIP K DIC Q

 ;

LRSTAR D B^LRU Q:Y<1

 S DIC="^LRD(65,",L=0,DHD="From: "_LRSTR_" To: "_LRLST Q

 ;

EDC W ! W $S(LROPT="I":"Edit Supplier charges before listing invoices?  NO// ",1:"Edit Supplier typing charges before listing ?  NO// ") R X:DTIME Q:X=""!(X[U)!(X?1"N".E)  G EDC:X'?1"Y".E

UNIT S (DIC,DIE)=65,DIC(0)="AEFQM",DIC("A")="Select donor unit: " D ^DIC G:X=""!(X[U) END S DA=+Y,DR=$S(LROPT="I":.1,1:.12) D ^DIE G UNIT

SET S %DT="",X="T" D ^%DT,D^LRU S LRH(0)=Y S IOP="HOME" D ^%ZIS Q

 ;

END D V^LRU Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRBLJP   1324     printed  Feb 18, 2025@23:37:12                                                                                                                                                                                                      Page 2

LRBLJP    ;AVAMC/REG - BB INVENTORY PRINT OPTS ;3/9/94  13:03 ;

 +1       ;;5.2;LAB SERVICE;**247**;Sep 27, 1994

 +2       ;Per VHA Directive 97-033 this routine should not be modified.  Medical Device # BK970021

S          KILL DIC

           WRITE !

           SET DIC=65

           SET DIC(0)="AEFQM"

           DO ^DIC

           if X=""!(X[U)

               GOTO END

           SET DIC="^LRD(65,"

           SET DA=+Y

           SET DR="0:ZZ"

           DO EN^DIQ

           GOTO S

 +1       ;

P          WRITE !

           SET DIC=65

           SET DIC(0)="AEFQM"

           SET L=0

           DO ^DIC

           if X=""!(X[U)!($ASCII(X)=46)

               GOTO END

           SET X=$PIECE(Y,U,2)

           SET FLDS="[CAPTIONED]"

           SET BY="UNIT ID"

           SET (FR,TO)=X

           SET DHD="Unit inquiry "_$$INS^LRU

           DO EN1^DIP

           KILL DIC

           QUIT 

 +1       ;

T          WRITE !!?27,"TYPING CHARGE LIST",!!

           DO EDC

           DO LRSTAR

           if Y<0

               GOTO END

           SET L=0

           SET DIC="^LRD(65,"

           SET FLDS="[LRBLDSP]"

           SET BY="DATE/TIME RECEIVED,TYPING CHARGE"

           SET FR=LRSDT

           SET TO=LRLDT

           KILL %ZIS

           DO EN1^DIP

           KILL DIC

           QUIT 

 +1       ;

I          DO SET

           DO EDC

           WRITE @IOF,?27,"SUPPLIER INVOICE LIST",!!

           SET L=0

           SET DIC="^LRD(65,"

           SET (FLDS,BY)="[LRBLINV]"

           SET DHD="Blood inventory list "_$$INS^LRU

           KILL %ZIS

           DO EN1^DIP

           KILL DIC

           QUIT 

 +1       ;

LRSTAR     DO B^LRU

           if Y<1

               QUIT 

 +1        SET DIC="^LRD(65,"

           SET L=0

           SET DHD="From: "_LRSTR_" To: "_LRLST

           QUIT 

 +2       ;

EDC        WRITE !

           WRITE $SELECT(LROPT="I":"Edit Supplier charges before listing invoices?  NO// ",1:"Edit Supplier typing charges before listing ?  NO// ")

           READ X:DTIME

           if X=""!(X[U)!(X?1"N".E)

               QUIT 

           if X'?1"Y".E

               GOTO EDC

UNIT       SET (DIC,DIE)=65

           SET DIC(0)="AEFQM"

           SET DIC("A")="Select donor unit: "

           DO ^DIC

           if X=""!(X[U)

               GOTO END

           SET DA=+Y

           SET DR=$SELECT(LROPT="I":.1,1:.12)

           DO ^DIE

           GOTO UNIT

SET        SET %DT=""

           SET X="T"

           DO ^%DT

           DO D^LRU

           SET LRH(0)=Y

           SET IOP="HOME"

           DO ^%ZIS

           QUIT 

 +1       ;

END        DO V^LRU

           QUIT