ALPBSP1 ;OIFO-DALLAS MW,SED,KC-LIST AND SELECT PATIENT'S ORDERS ;01/01/03
;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
;
; **NOTE: THIS ROUTINE IS CALLED BY A LIST MANAGER
; PROTOCOL IN WHICH A PATIENT HAS ALREADY BEEN
; SELECTED -- THIS ROUTINE SHOULD NOT BE RUN
; DIRECTLY.
;
EN ; -- main entry point for ALPB PATIENT ORDERS
D EN^VALM("PSB SELECT ORDERS")
Q
;
HDR ; -- header code
I +$G(ALPBIEN)'>0 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 ALPBHDR,ALPBPT,ALPBX
Q
;
INIT ; -- init variables and list array
I +$G(ALPBIEN)'>0 Q
K ALPBORDS,^TMP("ALPBORDS",$J)
D ORDS^ALPBUTL(ALPBIEN,"",.ALPBORDS)
K ALPBORDS("B")
I $G(ALPBLTYP)="" S ALPBLTYP="Active"
S ALPBX=0
F S ALPBX=$O(ALPBORDS(ALPBX)) Q:'ALPBX D
.I $G(ALPBORDS(ALPBX,2))="" S ALPBORDS(ALPBX,2)="XX"
.S ALPBORDS("B",ALPBORDS(ALPBX,2),ALPBORDS(ALPBX),ALPBX)=""
S ALPBLINE=0
S ALPBSTAT=""
F S ALPBSTAT=$O(ALPBORDS("B",ALPBSTAT)) Q:ALPBSTAT="" D
.S ALPBSTN=$$STAT2^ALPBUTL1(ALPBSTAT)
.I ALPBLTYP'="ALL"&(ALPBSTN'="Active") K ALPBSTN Q
.S ALPBORDN=""
.F S ALPBORDN=$O(ALPBORDS("B",ALPBSTAT,ALPBORDN)) Q:ALPBORDN="" D
..S ALPBX=0
..F S ALPBX=$O(ALPBORDS("B",ALPBSTAT,ALPBORDN,ALPBX)) Q:'ALPBX D
...S ^TMP("ALPBORDS",$J,"B",ALPBORDN)=ALPBX
...S ALPBLINE=ALPBLINE+1
...S ALPBDATA=" "_ALPBORDN
...S ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,12)_ALPBSTN
...S ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,21)_ALPBORDS(ALPBX,1)
...I +$G(ALPBORDS(ALPBX,3,0)) D
....S ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,26)_ALPBORDS(ALPBX,3,1)
...I $G(ALPBORDS(ALPBX,4))'="" D
....S ALPBY=$P(ALPBORDS(ALPBX,4),"^",1,3)
....S ALPBY=$TR(ALPBY,"^"," ")
....S ALPBDATA=ALPBDATA_" ("_ALPBY_")"
....K ALPBY
...S ^TMP("ALPBORDS",$J,ALPBLINE,0)=ALPBDATA
...K ALPBDATA
...S ALPBY=1
...F S ALPBY=$O(ALPBORDS(ALPBX,3,ALPBY)) Q:'ALPBY D
....S ALPBDATA=$$PAD^ALPBUTL($G(ALPBDATA),27)_ALPBORDS(ALPBX,3,ALPBY)
....S ALPBLINE=ALPBLINE+1
....S ^TMP("ALPBORDS",$J,ALPBLINE,0)=ALPBDATA
....K ALPBDATA
...K ALPBY
..K ALPBX
.K ALPBORDN,ALPBSTN
S VALMCNT=ALPBLINE
I +$O(^TMP("ALPBORDS",$J,0))=0&(ALPBLTYP="Active") D
.S ALPBLTYP="ALL"
.S VALM("TITLE")="BCMAbu ALL Orders List"
.D INIT
.S VALMBCK="R"
K ALPBLINE,ALPBLTYP,ALPBORDS,ALPBSTAT
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("ALPBORDS",$J)
Q
;
EXPND ; -- expand code
Q
;
SELORD ; select an order...
I '$D(^TMP("ALPBORDS",$J)) Q
S DIR(0)="FAO^1:45"
S DIR("A")="Select ORDER#: "
S DIR("A",1)="Select order number, more than one separated by a comma, or 'ALL': "
S DIR("B")="ALL"
S DIR("?")="Select order numbers from the list or 'ALL'."
S DIR("?",1)="Separate multiple order numbers with a comma."
D ^DIR K DIR
I $D(DIRUT) K DIRUT,DTOUT,X,Y Q
S ALPBOSEL=$$UP^XLFSTR($$STRIP^XLFSTR(Y," "))
I ALPBOSEL="ALL" D
.S I=0
.S ALPBOSEL=""
.F S ALPBOSEL=$O(^TMP("ALPBORDS",$J,"B",ALPBOSEL)) Q:ALPBOSEL="" D
..S I=I+1
..S ALPBOSEL(I)=^TMP("ALPBORDS",$J,"B",ALPBOSEL)
.S ALPBOSEL(0)=I
I ALPBOSEL'="ALL" D
.; make sure the input is separated by a comma...
.S ALPBOSEL=$$REPL^ALPBUTL2(ALPBOSEL,",")
.; parse out the user's input...
.F I=1:1 Q:$P(ALPBOSEL,",",I)="" D
..I $G(^TMP("ALPBORDS",$J,"B",$P(ALPBOSEL,",",I)))="" Q
..S ALPBOSEL(I)=^TMP("ALPBORDS",$J,"B",$P(ALPBOSEL,",",I))
I +$O(ALPBOSEL(0))=0 D Q
.W $C(7)
.W !,"Invalid selection."
.S DIR(0)="EA"
.S DIR("A")="Press <enter> to continue..."
.D ^DIR K DIR,DIRUT,DTOUT,X,Y
D EN^ALPBSP2
K ALPBOSEL
Q
;
SELALL ; set list type to ALL orders...
S ALPBLTYP="ALL"
S VALM("TITLE")="BCMAbu ALL Orders List"
D INIT
Q
;
SELACT ; set list type to Active orders...
S ALPBLTYP="Active"
S VALM("TITLE")="BCMAbu ACTIVE Orders List"
D INIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBSP1 3987 printed Dec 13, 2024@01:39:34 Page 2
ALPBSP1 ;OIFO-DALLAS MW,SED,KC-LIST AND SELECT PATIENT'S ORDERS ;01/01/03
+1 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
+2 ;
+3 ; **NOTE: THIS ROUTINE IS CALLED BY A LIST MANAGER
+4 ; PROTOCOL IN WHICH A PATIENT HAS ALREADY BEEN
+5 ; SELECTED -- THIS ROUTINE SHOULD NOT BE RUN
+6 ; DIRECTLY.
+7 ;
EN ; -- main entry point for ALPB PATIENT ORDERS
+1 DO EN^VALM("PSB SELECT ORDERS")
+2 QUIT
+3 ;
HDR ; -- header code
+1 IF +$GET(ALPBIEN)'>0
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 ALPBHDR,ALPBPT,ALPBX
+9 QUIT
+10 ;
INIT ; -- init variables and list array
+1 IF +$GET(ALPBIEN)'>0
QUIT
+2 KILL ALPBORDS,^TMP("ALPBORDS",$JOB)
+3 DO ORDS^ALPBUTL(ALPBIEN,"",.ALPBORDS)
+4 KILL ALPBORDS("B")
+5 IF $GET(ALPBLTYP)=""
SET ALPBLTYP="Active"
+6 SET ALPBX=0
+7 FOR
SET ALPBX=$ORDER(ALPBORDS(ALPBX))
if 'ALPBX
QUIT
Begin DoDot:1
+8 IF $GET(ALPBORDS(ALPBX,2))=""
SET ALPBORDS(ALPBX,2)="XX"
+9 SET ALPBORDS("B",ALPBORDS(ALPBX,2),ALPBORDS(ALPBX),ALPBX)=""
End DoDot:1
+10 SET ALPBLINE=0
+11 SET ALPBSTAT=""
+12 FOR
SET ALPBSTAT=$ORDER(ALPBORDS("B",ALPBSTAT))
if ALPBSTAT=""
QUIT
Begin DoDot:1
+13 SET ALPBSTN=$$STAT2^ALPBUTL1(ALPBSTAT)
+14 IF ALPBLTYP'="ALL"&(ALPBSTN'="Active")
KILL ALPBSTN
QUIT
+15 SET ALPBORDN=""
+16 FOR
SET ALPBORDN=$ORDER(ALPBORDS("B",ALPBSTAT,ALPBORDN))
if ALPBORDN=""
QUIT
Begin DoDot:2
+17 SET ALPBX=0
+18 FOR
SET ALPBX=$ORDER(ALPBORDS("B",ALPBSTAT,ALPBORDN,ALPBX))
if 'ALPBX
QUIT
Begin DoDot:3
+19 SET ^TMP("ALPBORDS",$JOB,"B",ALPBORDN)=ALPBX
+20 SET ALPBLINE=ALPBLINE+1
+21 SET ALPBDATA=" "_ALPBORDN
+22 SET ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,12)_ALPBSTN
+23 SET ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,21)_ALPBORDS(ALPBX,1)
+24 IF +$GET(ALPBORDS(ALPBX,3,0))
Begin DoDot:4
+25 SET ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,26)_ALPBORDS(ALPBX,3,1)
End DoDot:4
+26 IF $GET(ALPBORDS(ALPBX,4))'=""
Begin DoDot:4
+27 SET ALPBY=$PIECE(ALPBORDS(ALPBX,4),"^",1,3)
+28 SET ALPBY=$TRANSLATE(ALPBY,"^"," ")
+29 SET ALPBDATA=ALPBDATA_" ("_ALPBY_")"
+30 KILL ALPBY
End DoDot:4
+31 SET ^TMP("ALPBORDS",$JOB,ALPBLINE,0)=ALPBDATA
+32 KILL ALPBDATA
+33 SET ALPBY=1
+34 FOR
SET ALPBY=$ORDER(ALPBORDS(ALPBX,3,ALPBY))
if 'ALPBY
QUIT
Begin DoDot:4
+35 SET ALPBDATA=$$PAD^ALPBUTL($GET(ALPBDATA),27)_ALPBORDS(ALPBX,3,ALPBY)
+36 SET ALPBLINE=ALPBLINE+1
+37 SET ^TMP("ALPBORDS",$JOB,ALPBLINE,0)=ALPBDATA
+38 KILL ALPBDATA
End DoDot:4
+39 KILL ALPBY
End DoDot:3
+40 KILL ALPBX
End DoDot:2
+41 KILL ALPBORDN,ALPBSTN
End DoDot:1
+42 SET VALMCNT=ALPBLINE
+43 IF +$ORDER(^TMP("ALPBORDS",$JOB,0))=0&(ALPBLTYP="Active")
Begin DoDot:1
+44 SET ALPBLTYP="ALL"
+45 SET VALM("TITLE")="BCMAbu ALL Orders List"
+46 DO INIT
+47 SET VALMBCK="R"
End DoDot:1
+48 KILL ALPBLINE,ALPBLTYP,ALPBORDS,ALPBSTAT
+49 QUIT
+50 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("ALPBORDS",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
SELORD ; select an order...
+1 IF '$DATA(^TMP("ALPBORDS",$JOB))
QUIT
+2 SET DIR(0)="FAO^1:45"
+3 SET DIR("A")="Select ORDER#: "
+4 SET DIR("A",1)="Select order number, more than one separated by a comma, or 'ALL': "
+5 SET DIR("B")="ALL"
+6 SET DIR("?")="Select order numbers from the list or 'ALL'."
+7 SET DIR("?",1)="Separate multiple order numbers with a comma."
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
KILL DIRUT,DTOUT,X,Y
QUIT
+10 SET ALPBOSEL=$$UP^XLFSTR($$STRIP^XLFSTR(Y," "))
+11 IF ALPBOSEL="ALL"
Begin DoDot:1
+12 SET I=0
+13 SET ALPBOSEL=""
+14 FOR
SET ALPBOSEL=$ORDER(^TMP("ALPBORDS",$JOB,"B",ALPBOSEL))
if ALPBOSEL=""
QUIT
Begin DoDot:2
+15 SET I=I+1
+16 SET ALPBOSEL(I)=^TMP("ALPBORDS",$JOB,"B",ALPBOSEL)
End DoDot:2
+17 SET ALPBOSEL(0)=I
End DoDot:1
+18 IF ALPBOSEL'="ALL"
Begin DoDot:1
+19 ; make sure the input is separated by a comma...
+20 SET ALPBOSEL=$$REPL^ALPBUTL2(ALPBOSEL,",")
+21 ; parse out the user's input...
+22 FOR I=1:1
if $PIECE(ALPBOSEL,",",I)=""
QUIT
Begin DoDot:2
+23 IF $GET(^TMP("ALPBORDS",$JOB,"B",$PIECE(ALPBOSEL,",",I)))=""
QUIT
+24 SET ALPBOSEL(I)=^TMP("ALPBORDS",$JOB,"B",$PIECE(ALPBOSEL,",",I))
End DoDot:2
End DoDot:1
+25 IF +$ORDER(ALPBOSEL(0))=0
Begin DoDot:1
+26 WRITE $CHAR(7)
+27 WRITE !,"Invalid selection."
+28 SET DIR(0)="EA"
+29 SET DIR("A")="Press <enter> to continue..."
+30 DO ^DIR
KILL DIR,DIRUT,DTOUT,X,Y
End DoDot:1
QUIT
+31 DO EN^ALPBSP2
+32 KILL ALPBOSEL
+33 QUIT
+34 ;
SELALL ; set list type to ALL orders...
+1 SET ALPBLTYP="ALL"
+2 SET VALM("TITLE")="BCMAbu ALL Orders List"
+3 DO INIT
+4 QUIT
+5 ;
SELACT ; set list type to Active orders...
+1 SET ALPBLTYP="Active"
+2 SET VALM("TITLE")="BCMAbu ACTIVE Orders List"
+3 DO INIT
+4 QUIT
