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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBSP2 1161 printed Dec 13, 2024@01:39:34 Page 2
ALPBSP2 ;OIFO-DALLAS MW,SED,KC-SHOW SELECTED PATIENT ORDERS(S) ;01/01/03
+1 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
+2 ;
EN ; -- main entry point for ALPB SHOW ORDERS
+1 DO EN^VALM("PSB SHOW ORDERS")
+2 QUIT
+3 ;
HDR ; -- header code
+1 IF '$GET(ALPBIEN)
QUIT
+2 SET ALPBPT(0)=$GET(^ALPB(53.7,ALPBIEN,0))
+3 MERGE ALPBPT(1)=^ALPB(53.7,ALPBIEN,1)
+4 DO HDR^ALPBFRM2(.ALPBPT,"A",0,.ALPBHDR)
+5 SET ALPBX=1
+6 FOR
SET ALPBX=$ORDER(ALPBHDR(ALPBX))
if 'ALPBX
QUIT
Begin DoDot:1
+7 SET VALMHDR(ALPBX-1)=ALPBHDR(ALPBX)
End DoDot:1
+8 KILL ALPBPT,ALPBX
+9 QUIT
+10 ;
INIT ; -- init variables and list array
+1 IF '$GET(ALPBIEN)
QUIT
+2 KILL ^TMP("ALPBFORM",$JOB)
+3 SET ALPBLINE=0
+4 SET ALPBX=0
+5 FOR
SET ALPBX=$ORDER(ALPBOSEL(ALPBX))
if 'ALPBX
QUIT
Begin DoDot:1
+6 SET ALPBOIEN=ALPBOSEL(ALPBX)
+7 IF ALPBOIEN=""
KILL ALPBOIEN
QUIT
+8 MERGE ALPBDATA=^ALPB(53.7,ALPBIEN,2,ALPBOIEN)
+9 DO F80^ALPBFRM2(.ALPBDATA,"",.ALPBFORM)
+10 SET ALPBY=0
+11 FOR
SET ALPBY=$ORDER(ALPBFORM(ALPBY))
if 'ALPBY
QUIT
Begin DoDot:2
+12 SET ALPBLINE=ALPBLINE+1
+13 SET ^TMP("ALPBFORM",$JOB,ALPBLINE,0)=ALPBFORM(ALPBY)
End DoDot:2
+14 KILL ALPBDATA,ALPBFORM,ALPBOIEN,ALPBY
End DoDot:1
+15 SET VALMCNT=ALPBLINE
+16 KILL ALPBLINE,ALPBOIEN,ALPBX
+17 QUIT
+18 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("ALPBFORM",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
