VistA-WorldVistAEHR/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBSP2.m

49 lines
1.1 KiB
Mathematica

ALPBSP2 ;OIFO-DALLAS MW,SED,KC-SHOW SELECTED PATIENT ORDERS(S) ;01/01/03
;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
;
EN ; -- main entry point for ALPB SHOW ORDERS
D EN^VALM("PSB SHOW ORDERS")
Q
;
HDR ; -- header code
I '$G(ALPBIEN) Q
S ALPBPT(0)=$G(^ALPB(53.7,ALPBIEN,0))
M ALPBPT(1)=^ALPB(53.7,ALPBIEN,1)
D HDR^ALPBFRM2(.ALPBPT,"A",0,.ALPBHDR)
S ALPBX=1
F S ALPBX=$O(ALPBHDR(ALPBX)) Q:'ALPBX D
.S VALMHDR(ALPBX-1)=ALPBHDR(ALPBX)
K ALPBPT,ALPBX
Q
;
INIT ; -- init variables and list array
I '$G(ALPBIEN) Q
K ^TMP("ALPBFORM",$J)
S ALPBLINE=0
S ALPBX=0
F S ALPBX=$O(ALPBOSEL(ALPBX)) Q:'ALPBX D
.S ALPBOIEN=ALPBOSEL(ALPBX)
.I ALPBOIEN="" K ALPBOIEN Q
.M ALPBDATA=^ALPB(53.7,ALPBIEN,2,ALPBOIEN)
.D F80^ALPBFRM2(.ALPBDATA,"",.ALPBFORM)
.S ALPBY=0
.F S ALPBY=$O(ALPBFORM(ALPBY)) Q:'ALPBY D
..S ALPBLINE=ALPBLINE+1
..S ^TMP("ALPBFORM",$J,ALPBLINE,0)=ALPBFORM(ALPBY)
.K ALPBDATA,ALPBFORM,ALPBOIEN,ALPBY
S VALMCNT=ALPBLINE
K ALPBLINE,ALPBOIEN,ALPBX
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("ALPBFORM",$J)
Q
;
EXPND ; -- expand code
Q
;