ALPBSP1.m

ALPBSP1 ;OIFO-DALLAS MW,SED,KC-LIST AND SELECT PATIENT'S ORDERS ;01/01/03

 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004

 ;

 ; **NOTE:  THIS ROUTINE IS CALLED BY A LIST MANAGER

 ;          PROTOCOL IN WHICH A PATIENT HAS ALREADY BEEN

 ;          SELECTED -- THIS ROUTINE SHOULD NOT BE RUN

 ;          DIRECTLY.

 ;

EN ; -- main entry point for ALPB PATIENT ORDERS

 D EN^VALM("PSB SELECT ORDERS")

 Q

 ;

HDR ; -- header code

 I +$G(ALPBIEN)'>0 Q

 S ALPBPT(0)=$G(^ALPB(53.7,ALPBIEN,0))

 M ALPBPT(1)=^ALPB(53.7,ALPBIEN,1)

 D HDR^ALPBFRM2(.ALPBPT,"A",0,.ALPBHDR)

 S ALPBX=1

 F  S ALPBX=$O(ALPBHDR(ALPBX)) Q:'ALPBX  D

 .S VALMHDR(ALPBX-1)=ALPBHDR(ALPBX)

 K ALPBHDR,ALPBPT,ALPBX

 Q

 ;

INIT ; -- init variables and list array

 I +$G(ALPBIEN)'>0 Q

 K ALPBORDS,^TMP("ALPBORDS",$J)

 D ORDS^ALPBUTL(ALPBIEN,"",.ALPBORDS)

 K ALPBORDS("B")

 I $G(ALPBLTYP)="" S ALPBLTYP="Active"

 S ALPBX=0

 F  S ALPBX=$O(ALPBORDS(ALPBX)) Q:'ALPBX  D

 .I $G(ALPBORDS(ALPBX,2))="" S ALPBORDS(ALPBX,2)="XX"

 .S ALPBORDS("B",ALPBORDS(ALPBX,2),ALPBORDS(ALPBX),ALPBX)=""

 S ALPBLINE=0

 S ALPBSTAT=""

 F  S ALPBSTAT=$O(ALPBORDS("B",ALPBSTAT)) Q:ALPBSTAT=""  D

 .S ALPBSTN=$$STAT2^ALPBUTL1(ALPBSTAT)

 .I ALPBLTYP'="ALL"&(ALPBSTN'="Active") K ALPBSTN Q

 .S ALPBORDN=""

 .F  S ALPBORDN=$O(ALPBORDS("B",ALPBSTAT,ALPBORDN)) Q:ALPBORDN=""  D

 ..S ALPBX=0

 ..F  S ALPBX=$O(ALPBORDS("B",ALPBSTAT,ALPBORDN,ALPBX)) Q:'ALPBX  D

 ...S ^TMP("ALPBORDS",$J,"B",ALPBORDN)=ALPBX

 ...S ALPBLINE=ALPBLINE+1

 ...S ALPBDATA=" "_ALPBORDN

 ...S ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,12)_ALPBSTN

 ...S ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,21)_ALPBORDS(ALPBX,1)

 ...I +$G(ALPBORDS(ALPBX,3,0)) D

 ....S ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,26)_ALPBORDS(ALPBX,3,1)

 ...I $G(ALPBORDS(ALPBX,4))'="" D

 ....S ALPBY=$P(ALPBORDS(ALPBX,4),"^",1,3)

 ....S ALPBY=$TR(ALPBY,"^"," ")

 ....S ALPBDATA=ALPBDATA_" ("_ALPBY_")"

 ....K ALPBY

 ...S ^TMP("ALPBORDS",$J,ALPBLINE,0)=ALPBDATA

 ...K ALPBDATA

 ...S ALPBY=1

 ...F  S ALPBY=$O(ALPBORDS(ALPBX,3,ALPBY)) Q:'ALPBY  D

 ....S ALPBDATA=$$PAD^ALPBUTL($G(ALPBDATA),27)_ALPBORDS(ALPBX,3,ALPBY)

 ....S ALPBLINE=ALPBLINE+1

 ....S ^TMP("ALPBORDS",$J,ALPBLINE,0)=ALPBDATA

 ....K ALPBDATA

 ...K ALPBY

 ..K ALPBX

 .K ALPBORDN,ALPBSTN

 S VALMCNT=ALPBLINE

 I +$O(^TMP("ALPBORDS",$J,0))=0&(ALPBLTYP="Active") D

 .S ALPBLTYP="ALL"

 .S VALM("TITLE")="BCMAbu ALL Orders List"

 .D INIT

 .S VALMBCK="R"

 K ALPBLINE,ALPBLTYP,ALPBORDS,ALPBSTAT

 Q

 ;

HELP ; -- help code

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

 Q

 ;

EXIT ; -- exit code

 K ^TMP("ALPBORDS",$J)

 Q

 ;

EXPND ; -- expand code

 Q

 ;

SELORD ; select an order...

 I '$D(^TMP("ALPBORDS",$J)) Q

 S DIR(0)="FAO^1:45"

 S DIR("A")="Select ORDER#: "

 S DIR("A",1)="Select order number, more than one separated by a comma, or 'ALL': "

 S DIR("B")="ALL"

 S DIR("?")="Select order numbers from the list or 'ALL'."

 S DIR("?",1)="Separate multiple order numbers with a comma."

 D ^DIR K DIR

 I $D(DIRUT) K DIRUT,DTOUT,X,Y Q

 S ALPBOSEL=$$UP^XLFSTR($$STRIP^XLFSTR(Y," "))

 I ALPBOSEL="ALL" D

 .S I=0

 .S ALPBOSEL=""

 .F  S ALPBOSEL=$O(^TMP("ALPBORDS",$J,"B",ALPBOSEL)) Q:ALPBOSEL=""  D

 ..S I=I+1

 ..S ALPBOSEL(I)=^TMP("ALPBORDS",$J,"B",ALPBOSEL)

 .S ALPBOSEL(0)=I

 I ALPBOSEL'="ALL" D

 .; make sure the input is separated by a comma...

 .S ALPBOSEL=$$REPL^ALPBUTL2(ALPBOSEL,",")

 .; parse out the user's input...

 .F I=1:1 Q:$P(ALPBOSEL,",",I)=""  D

 ..I $G(^TMP("ALPBORDS",$J,"B",$P(ALPBOSEL,",",I)))="" Q

 ..S ALPBOSEL(I)=^TMP("ALPBORDS",$J,"B",$P(ALPBOSEL,",",I))

 I +$O(ALPBOSEL(0))=0 D  Q

 .W $C(7)

 .W !,"Invalid selection."

 .S DIR(0)="EA"

 .S DIR("A")="Press <enter> to continue..."

 .D ^DIR K DIR,DIRUT,DTOUT,X,Y

 D EN^ALPBSP2

 K ALPBOSEL

 Q

 ;

SELALL ; set list type to ALL orders...

 S ALPBLTYP="ALL"

 S VALM("TITLE")="BCMAbu ALL Orders List"

 D INIT

 Q

 ;

SELACT ; set list type to Active orders...

 S ALPBLTYP="Active"

 S VALM("TITLE")="BCMAbu ACTIVE Orders List"

 D INIT

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ALPBSP1   3987     printed  Feb 18, 2025@23:05:57                                                                                                                                                                                                     Page 2

ALPBSP1   ;OIFO-DALLAS MW,SED,KC-LIST AND SELECT PATIENT'S ORDERS ;01/01/03

 +1       ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004

 +2       ;

 +3       ; **NOTE:  THIS ROUTINE IS CALLED BY A LIST MANAGER

 +4       ;          PROTOCOL IN WHICH A PATIENT HAS ALREADY BEEN

 +5       ;          SELECTED -- THIS ROUTINE SHOULD NOT BE RUN

 +6       ;          DIRECTLY.

 +7       ;

EN        ; -- main entry point for ALPB PATIENT ORDERS

 +1        DO EN^VALM("PSB SELECT ORDERS")

 +2        QUIT 

 +3       ;

HDR       ; -- header code

 +1        IF +$GET(ALPBIEN)'>0

               QUIT 

 +2        SET ALPBPT(0)=$GET(^ALPB(53.7,ALPBIEN,0))

 +3        MERGE ALPBPT(1)=^ALPB(53.7,ALPBIEN,1)

 +4        DO HDR^ALPBFRM2(.ALPBPT,"A",0,.ALPBHDR)

 +5        SET ALPBX=1

 +6        FOR 

               SET ALPBX=$ORDER(ALPBHDR(ALPBX))

               if 'ALPBX

                   QUIT 

               Begin DoDot:1

 +7                SET VALMHDR(ALPBX-1)=ALPBHDR(ALPBX)

               End DoDot:1

 +8        KILL ALPBHDR,ALPBPT,ALPBX

 +9        QUIT 

 +10      ;

INIT      ; -- init variables and list array

 +1        IF +$GET(ALPBIEN)'>0

               QUIT 

 +2        KILL ALPBORDS,^TMP("ALPBORDS",$JOB)

 +3        DO ORDS^ALPBUTL(ALPBIEN,"",.ALPBORDS)

 +4        KILL ALPBORDS("B")

 +5        IF $GET(ALPBLTYP)=""

               SET ALPBLTYP="Active"

 +6        SET ALPBX=0

 +7        FOR 

               SET ALPBX=$ORDER(ALPBORDS(ALPBX))

               if 'ALPBX

                   QUIT 

               Begin DoDot:1

 +8                IF $GET(ALPBORDS(ALPBX,2))=""

                       SET ALPBORDS(ALPBX,2)="XX"

 +9                SET ALPBORDS("B",ALPBORDS(ALPBX,2),ALPBORDS(ALPBX),ALPBX)=""

               End DoDot:1

 +10       SET ALPBLINE=0

 +11       SET ALPBSTAT=""

 +12       FOR 

               SET ALPBSTAT=$ORDER(ALPBORDS("B",ALPBSTAT))

               if ALPBSTAT=""

                   QUIT 

               Begin DoDot:1

 +13               SET ALPBSTN=$$STAT2^ALPBUTL1(ALPBSTAT)

 +14               IF ALPBLTYP'="ALL"&(ALPBSTN'="Active")

                       KILL ALPBSTN

                       QUIT 

 +15               SET ALPBORDN=""

 +16               FOR 

                       SET ALPBORDN=$ORDER(ALPBORDS("B",ALPBSTAT,ALPBORDN))

                       if ALPBORDN=""

                           QUIT 

                       Begin DoDot:2

 +17                       SET ALPBX=0

 +18                       FOR 

                               SET ALPBX=$ORDER(ALPBORDS("B",ALPBSTAT,ALPBORDN,ALPBX))

                               if 'ALPBX

                                   QUIT 

                               Begin DoDot:3

 +19                               SET ^TMP("ALPBORDS",$JOB,"B",ALPBORDN)=ALPBX

 +20                               SET ALPBLINE=ALPBLINE+1

 +21                               SET ALPBDATA=" "_ALPBORDN

 +22                               SET ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,12)_ALPBSTN

 +23                               SET ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,21)_ALPBORDS(ALPBX,1)

 +24                               IF +$GET(ALPBORDS(ALPBX,3,0))

                                       Begin DoDot:4

 +25                                       SET ALPBDATA=$$PAD^ALPBUTL(ALPBDATA,26)_ALPBORDS(ALPBX,3,1)

                                       End DoDot:4

 +26                               IF $GET(ALPBORDS(ALPBX,4))'=""

                                       Begin DoDot:4

 +27                                       SET ALPBY=$PIECE(ALPBORDS(ALPBX,4),"^",1,3)

 +28                                       SET ALPBY=$TRANSLATE(ALPBY,"^"," ")

 +29                                       SET ALPBDATA=ALPBDATA_" ("_ALPBY_")"

 +30                                       KILL ALPBY

                                       End DoDot:4

 +31                               SET ^TMP("ALPBORDS",$JOB,ALPBLINE,0)=ALPBDATA

 +32                               KILL ALPBDATA

 +33                               SET ALPBY=1

 +34                               FOR 

                                       SET ALPBY=$ORDER(ALPBORDS(ALPBX,3,ALPBY))

                                       if 'ALPBY

                                           QUIT 

                                       Begin DoDot:4

 +35                                       SET ALPBDATA=$$PAD^ALPBUTL($GET(ALPBDATA),27)_ALPBORDS(ALPBX,3,ALPBY)

 +36                                       SET ALPBLINE=ALPBLINE+1

 +37                                       SET ^TMP("ALPBORDS",$JOB,ALPBLINE,0)=ALPBDATA

 +38                                       KILL ALPBDATA

                                       End DoDot:4

 +39                               KILL ALPBY

                               End DoDot:3

 +40                       KILL ALPBX

                       End DoDot:2

 +41               KILL ALPBORDN,ALPBSTN

               End DoDot:1

 +42       SET VALMCNT=ALPBLINE

 +43       IF +$ORDER(^TMP("ALPBORDS",$JOB,0))=0&(ALPBLTYP="Active")

               Begin DoDot:1

 +44               SET ALPBLTYP="ALL"

 +45               SET VALM("TITLE")="BCMAbu ALL Orders List"

 +46               DO INIT

 +47               SET VALMBCK="R"

               End DoDot:1

 +48       KILL ALPBLINE,ALPBLTYP,ALPBORDS,ALPBSTAT

 +49       QUIT 

 +50      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL ^TMP("ALPBORDS",$JOB)

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;

SELORD    ; select an order...

 +1        IF '$DATA(^TMP("ALPBORDS",$JOB))

               QUIT 

 +2        SET DIR(0)="FAO^1:45"

 +3        SET DIR("A")="Select ORDER#: "

 +4        SET DIR("A",1)="Select order number, more than one separated by a comma, or 'ALL': "

 +5        SET DIR("B")="ALL"

 +6        SET DIR("?")="Select order numbers from the list or 'ALL'."

 +7        SET DIR("?",1)="Separate multiple order numbers with a comma."

 +8        DO ^DIR

           KILL DIR

 +9        IF $DATA(DIRUT)

               KILL DIRUT,DTOUT,X,Y

               QUIT 

 +10       SET ALPBOSEL=$$UP^XLFSTR($$STRIP^XLFSTR(Y," "))

 +11       IF ALPBOSEL="ALL"

               Begin DoDot:1

 +12               SET I=0

 +13               SET ALPBOSEL=""

 +14               FOR 

                       SET ALPBOSEL=$ORDER(^TMP("ALPBORDS",$JOB,"B",ALPBOSEL))

                       if ALPBOSEL=""

                           QUIT 

                       Begin DoDot:2

 +15                       SET I=I+1

 +16                       SET ALPBOSEL(I)=^TMP("ALPBORDS",$JOB,"B",ALPBOSEL)

                       End DoDot:2

 +17               SET ALPBOSEL(0)=I

               End DoDot:1

 +18       IF ALPBOSEL'="ALL"

               Begin DoDot:1

 +19      ; make sure the input is separated by a comma...

 +20               SET ALPBOSEL=$$REPL^ALPBUTL2(ALPBOSEL,",")

 +21      ; parse out the user's input...

 +22               FOR I=1:1

                       if $PIECE(ALPBOSEL,",",I)=""

                           QUIT 

                       Begin DoDot:2

 +23                       IF $GET(^TMP("ALPBORDS",$JOB,"B",$PIECE(ALPBOSEL,",",I)))=""

                               QUIT 

 +24                       SET ALPBOSEL(I)=^TMP("ALPBORDS",$JOB,"B",$PIECE(ALPBOSEL,",",I))

                       End DoDot:2

               End DoDot:1

 +25       IF +$ORDER(ALPBOSEL(0))=0

               Begin DoDot:1

 +26               WRITE $CHAR(7)

 +27               WRITE !,"Invalid selection."

 +28               SET DIR(0)="EA"

 +29               SET DIR("A")="Press <enter> to continue..."

 +30               DO ^DIR

                   KILL DIR,DIRUT,DTOUT,X,Y

               End DoDot:1

               QUIT 

 +31       DO EN^ALPBSP2

 +32       KILL ALPBOSEL

 +33       QUIT 

 +34      ;

SELALL    ; set list type to ALL orders...

 +1        SET ALPBLTYP="ALL"

 +2        SET VALM("TITLE")="BCMAbu ALL Orders List"

 +3        DO INIT

 +4        QUIT 

 +5       ;

SELACT    ; set list type to Active orders...

 +1        SET ALPBLTYP="Active"

 +2        SET VALM("TITLE")="BCMAbu ACTIVE Orders List"

 +3        DO INIT

 +4        QUIT