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 ---[H[J[2J[HLRBLJP 1324 printed Dec 13, 2024@02:11:19 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
