ALPBSPAT ;OIFO-DALLAS MW,SED,KC-SELECT AND SHOW PATIENT ORDER(S) ;01/01/03
;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
;
EN ; -- main entry point for ALPB SELECT PATIENT
D EN^VALM("PSB SELECT PATIENT")
Q
;
HDR ; -- header code
S VALMHDR(1)="BCMA Backup System :: Patient Listing"
Q
;
INIT ; -- init variables and list array
K ^TMP("ALPBPLIST",$J)
I $G(ALPBLTYP)="" S ALPBLTYP="ALL"
D PTLIST^ALPBUTL1(ALPBLTYP,.ALPBLIST)
S (ALPBLINE,ALPBX)=0
F S ALPBX=$O(ALPBLIST(ALPBX)) Q:'ALPBX D
.S ALPBDATA=" "_$P(ALPBLIST(ALPBX),"^")
.S ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,31)_$P(ALPBLIST(ALPBX),"^",2)
.S ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,41)_$P(ALPBLIST(ALPBX),"^",3)
.I $P(ALPBLIST(ALPBX),"^",4)']"" S $P(ALPBLIST(ALPBX),"^",4)="Unknown"
.S ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,60)_$P(ALPBLIST(ALPBX),"^",4)
.I $P(ALPBLIST(ALPBX),"^",5)']"" S $P(ALPBLIST(ALPBX),"^",5)="?"
.S ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,70)_$P(ALPBLIST(ALPBX),"^",5)
.S ALPBLINE=ALPBLINE+1
.S ^TMP("ALPBPLIST",$J,ALPBLINE,0)=ALPBDATA
.K ALPBDATA
S VALMCNT=ALPBLINE
K ALPBLINE,ALPBLIST,ALPBLTYP
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("ALPBPLIST",$J)
Q
;
EXPND ; -- expand code
Q
;
SELALL ; reset and list all patients...
S ALPBLTYP="ALL"
S VALM("TITLE")="BCMAbu Patient List (All)"
D INIT
Q
;
SELWARD ; select list type...
N ALPBSEL,DIR,DIRUT,DTOUT,X,Y
I $G(ALPBLTYP)="" S ALPBLTYP=""
D FULL^VALM1
D WARDLIST^ALPBUTL("C")
F D Q:$D(DIRUT)!($G(ALPBLTYP)'="")
.S DIR(0)="FAO^1:45"
.S DIR("A")="Select WARD: "
.S DIR("?")="^D WARDLIST^ALPBUTL(""C"")"
.W !
.D ^DIR K DIR
.I $D(DIRUT) Q
.D WARDSEL^ALPBUTL(Y,.ALPBSEL)
.I +$G(ALPBSEL(0))=0 D Q
..W $C(7)
..W " ?? -- not a valid ward selection"
.I +$G(ALPBSEL(0))=1 S ALPBLTYP=ALPBSEL(1) Q
.F I=1:1:ALPBSEL(0) W !?2,I," ",ALPBSEL(I)
.S DIR(0)="NA^1:"_ALPBSEL(0)
.S DIR("A")="Which one? (1-"_ALPBSEL(0)_")"
.D ^DIR K DIR
.I $D(DIRUT) Q
.S ALPBLTYP=ALPBSEL(+Y)
I $D(DIRUT) K DIRUT,DTOUT,X,Y Q
S VALM("TITLE")="BCMAbu Patient List (Ward)"
D INIT
I $G(VALMBG)'=1 D FIRST^VALM4
Q
;
SELPAT ; select patient...
N DIR,DIRUT,DTOUT,X,Y
S DIR(0)="PAO^53.7:QEMZ"
S DIR("A")="Select PATIENT: "
D ^DIR K DIR
I $D(DIRUT) K DIRUT,DTOUT,X,Y Q
S ALPBIEN=+Y
D ^ALPBSP1
K ALPBIEN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBSPAT 2363 printed Dec 13, 2024@01:39:35 Page 2
ALPBSPAT ;OIFO-DALLAS MW,SED,KC-SELECT AND SHOW PATIENT ORDER(S) ;01/01/03
+1 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
+2 ;
EN ; -- main entry point for ALPB SELECT PATIENT
+1 DO EN^VALM("PSB SELECT PATIENT")
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)="BCMA Backup System :: Patient Listing"
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 KILL ^TMP("ALPBPLIST",$JOB)
+2 IF $GET(ALPBLTYP)=""
SET ALPBLTYP="ALL"
+3 DO PTLIST^ALPBUTL1(ALPBLTYP,.ALPBLIST)
+4 SET (ALPBLINE,ALPBX)=0
+5 FOR
SET ALPBX=$ORDER(ALPBLIST(ALPBX))
if 'ALPBX
QUIT
Begin DoDot:1
+6 SET ALPBDATA=" "_$PIECE(ALPBLIST(ALPBX),"^")
+7 SET ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,31)_$PIECE(ALPBLIST(ALPBX),"^",2)
+8 SET ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,41)_$PIECE(ALPBLIST(ALPBX),"^",3)
+9 IF $PIECE(ALPBLIST(ALPBX),"^",4)']""
SET $PIECE(ALPBLIST(ALPBX),"^",4)="Unknown"
+10 SET ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,60)_$PIECE(ALPBLIST(ALPBX),"^",4)
+11 IF $PIECE(ALPBLIST(ALPBX),"^",5)']""
SET $PIECE(ALPBLIST(ALPBX),"^",5)="?"
+12 SET ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,70)_$PIECE(ALPBLIST(ALPBX),"^",5)
+13 SET ALPBLINE=ALPBLINE+1
+14 SET ^TMP("ALPBPLIST",$JOB,ALPBLINE,0)=ALPBDATA
+15 KILL ALPBDATA
End DoDot:1
+16 SET VALMCNT=ALPBLINE
+17 KILL ALPBLINE,ALPBLIST,ALPBLTYP
+18 QUIT
+19 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("ALPBPLIST",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
SELALL ; reset and list all patients...
+1 SET ALPBLTYP="ALL"
+2 SET VALM("TITLE")="BCMAbu Patient List (All)"
+3 DO INIT
+4 QUIT
+5 ;
SELWARD ; select list type...
+1 NEW ALPBSEL,DIR,DIRUT,DTOUT,X,Y
+2 IF $GET(ALPBLTYP)=""
SET ALPBLTYP=""
+3 DO FULL^VALM1
+4 DO WARDLIST^ALPBUTL("C")
+5 FOR
Begin DoDot:1
+6 SET DIR(0)="FAO^1:45"
+7 SET DIR("A")="Select WARD: "
+8 SET DIR("?")="^D WARDLIST^ALPBUTL(""C"")"
+9 WRITE !
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
QUIT
+12 DO WARDSEL^ALPBUTL(Y,.ALPBSEL)
+13 IF +$GET(ALPBSEL(0))=0
Begin DoDot:2
+14 WRITE $CHAR(7)
+15 WRITE " ?? -- not a valid ward selection"
End DoDot:2
QUIT
+16 IF +$GET(ALPBSEL(0))=1
SET ALPBLTYP=ALPBSEL(1)
QUIT
+17 FOR I=1:1:ALPBSEL(0)
WRITE !?2,I," ",ALPBSEL(I)
+18 SET DIR(0)="NA^1:"_ALPBSEL(0)
+19 SET DIR("A")="Which one? (1-"_ALPBSEL(0)_")"
+20 DO ^DIR
KILL DIR
+21 IF $DATA(DIRUT)
QUIT
+22 SET ALPBLTYP=ALPBSEL(+Y)
End DoDot:1
if $DATA(DIRUT)!($GET(ALPBLTYP)'="")
QUIT
+23 IF $DATA(DIRUT)
KILL DIRUT,DTOUT,X,Y
QUIT
+24 SET VALM("TITLE")="BCMAbu Patient List (Ward)"
+25 DO INIT
+26 IF $GET(VALMBG)'=1
DO FIRST^VALM4
+27 QUIT
+28 ;
SELPAT ; select patient...
+1 NEW DIR,DIRUT,DTOUT,X,Y
+2 SET DIR(0)="PAO^53.7:QEMZ"
+3 SET DIR("A")="Select PATIENT: "
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
KILL DIRUT,DTOUT,X,Y
QUIT
+6 SET ALPBIEN=+Y
+7 DO ^ALPBSP1
+8 KILL ALPBIEN
+9 QUIT
