VistA-WorldVistAEHR/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBSPAT.m

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