Routine: ALPBSPAT

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")

HDR ; -- header code

 S VALMHDR(1)="BCMA Backup System :: Patient Listing"

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

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

EXIT ; -- exit code

 K ^TMP("ALPBPLIST",$J)

EXPND ; -- expand code

SELALL ; reset and list all patients...

 S ALPBLTYP="ALL"

 S VALM("TITLE")="BCMAbu Patient List (All)"

 D INIT

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBSPAT   2363     printed  Feb 18, 2025@23:05:59                                                                                                                                                                                                    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

ALPBSPAT.m