Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ALPBSPAT

ALPBSPAT.m

Go to the documentation of this file.
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