88 lines
2.2 KiB
Mathematica
88 lines
2.2 KiB
Mathematica
|
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
|