ALPBSP2.m

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

 ;

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       ;