PSBIHS6.m

PSBIHS6 ;KF/VAOIT  PSBO BZ LABEL PRT FROM IOE 

 ;;1.0;PSB BCMA CPS FOXK;**1018**;;Build 27

SELECT ; Select orderS from list

 N PSGLMT,PSGODDD,PSJLMQT,PSJLMFIN,PSJUDPRF,PSGRDTX K ^TMP("PSJCOM",$J),^TMP("PSJCOM2",$J)

 N DIE,DIR,ON,PSBSIO,PSGONC,PSGORD,PSJORD,PSJSEL,PSJSEL1,X,Y,ZTDESC,ZTDTH,ZTRN,ZTSK,ZTRTN,ZTIO

 S PSGONC=1,PSGLMT=^TMP("PSJPRO",$J,0) D ENASR^PSGON

 I "^"[X S VALMQUIT=1 Q

 S PSJLM=1,PSJSEL=0 F  S PSJSEL=$O(PSGODDD(PSJSEL)) Q:'PSJSEL!($G(Y)<0)  F PSJSEL1=1:1:$L(PSGODDD(PSJSEL),",")-1 D

 .S PSJORD=$G(^TMP("PSJON",$J,+$P(PSGODDD(PSJSEL),",",PSJSEL1))) D:PSJORD=+PSJORD SELECT^PSJOEA Q:PSJORD=""!($G(Y)<0)  Q:PSJORD=+PSJORD  D

 ..Q:('$$LS^PSSLOCK(PSGP,PSJORD))

 ..Q:PSJORD=+PSJORD

 ..S PSGORD=""

 ..Q:PSJORD'["U"

 ..S ON=PSJORD D BCMA

 ..Q:$G(Y)<0

 S VALMBCK="Q"

 K PSJLM

 Q

BCMA ;GET DISPENSE DRUG INFO

 N PSBANS,PSBANS1,PSBRPT,PSBSAVE,DA,DIK,DR,DDSFILE,CPSDIEN,CPSDIEN1

 K CPSDRGS

 W @IOF

 ;DRUG INFO ALL ACTIVE DISPENSE

 S CPSDIEN=0 F  S CPSDIEN=$O(^PS(55,DFN,5,+PSJORD,1,"B",CPSDIEN)) Q:CPSDIEN'>0  D

 .S CPSDIEN1=0 F  S CPSDIEN1=$O(^PS(55,DFN,5,+PSJORD,1,"B",CPSDIEN,CPSDIEN1)) Q:CPSDIEN1'>0  D

 ..Q:$P($G(^PS(55,DFN,5,+PSJORD,1,CPSDIEN1,0)),U,3)'=""  ;BAIL IF INACTIVE DATE

 ..S CPSDRGS(CPSDIEN)=$J($P($G(^PS(55,DFN,5,+PSJORD,1,CPSDIEN1,0)),U,2),0,0)  ;BCMA UNIT GIVE ROUND UP

 S CPSDIEN=0  F  S CPSDIEN=$O(CPSDRGS(CPSDIEN)) Q:CPSDIEN'>0  D BL

 Q

BL ; FILE LABELS

 N PSBTYPE,PSBPRT,CPSMAN,CPSEXP,CPSLOT,CPSDOSE

 W @IOF

 ;FROM PSBOBZ

 S PSBTYPE="BZ" D NEW^PSBO1(.PSBRPT,PSBTYPE)

 I +PSBRPT(0)<1 W !,"Error: ",$P(PSBRPT(0),U,2) S DIR(0)="E" D ^DIR Q

 S DA=+PSBRPT(0),DIE="^PSB(53.69,"

 ;END PSBOBZ 

 S CPSMAN=$P($G(^PSDRUG(CPSDIEN,999999924)),U,1)

 S CPSLOT=$P($G(^PSDRUG(CPSDIEN,999999924)),U,2)

 S CPSEXP=$P($G(^PSDRUG(CPSDIEN,660)),U,9)

 S CPSDOSE=$P(^PS(55,DFN,5,+PSJORD,.2),U,2)

 S DR=".31///^S X=CPSDIEN" D ^DIE

 I $G(CPSLOT)'="" S DR=".32///^S X=CPSLOT" D ^DIE

 I $G(CPSEXP)'="" S DR=".33///^S X=CPSEXP" D ^DIE

 I $G(CPSMAN)'="" S DR=".34///^S X=CPSMAN" D ^DIE

 S DR=".38///^S X=$G(CPSDRGS(CPSDIEN))" D ^DIE

 S:$G(IOP)'="" DR=".06///^S X=IOP" D ^DIE

 D NOW^%DTC S DR=".07///^S X=%" D ^DIE

 S DR=".12///^S X=DFN" D ^DIE

 S DR=".39///^S X=CPSDOSE" D ^DIE

 ;BELOW LOGIC FROM PSBOBZ

 S DR="[PSBO "_PSBTYPE_"]",DDSFILE=53.69 D ^DDS

 I 'PSBSAVE W !,"Cancelling Request..." S DIK="^PSB(53.69," D ^DIK W "Cancelled!"

 D:PSBSAVE

 .S IOP=$$GET1^DIQ(53.69,DA_",",.06,"I"),PSBSIO=0

 .W !,"Submitting Your Report Request to TaskMan..." H 1

 .S ZTIO=$$GET1^DIQ(53.69,DA_",",.06)

 .S ZTDTH=$P(^PSB(53.69,DA,0),U,7)

 .S ZTDESC="BCMA - "_$$GET1^DIQ(53.69,DA_",",.05)

 .S ZTRTN="DQ^PSBO("_DA_")"

 .D ^%ZTLOAD

 .W !,"Submitted!",!,"Your Task Number Is: ",$G(ZTSK),! H 1

 Q

PSBIHS6   ;KF/VAOIT  PSBO BZ LABEL PRT FROM IOE 

 +1       ;;1.0;PSB BCMA CPS FOXK;**1018**;;Build 27

SELECT    ; Select orderS from list

 +1        NEW PSGLMT,PSGODDD,PSJLMQT,PSJLMFIN,PSJUDPRF,PSGRDTX

           KILL ^TMP("PSJCOM",$JOB),^TMP("PSJCOM2",$JOB)

 +2        NEW DIE,DIR,ON,PSBSIO,PSGONC,PSGORD,PSJORD,PSJSEL,PSJSEL1,X,Y,ZTDESC,ZTDTH,ZTRN,ZTSK,ZTRTN,ZTIO

 +3        SET PSGONC=1

           SET PSGLMT=^TMP("PSJPRO",$JOB,0)

           DO ENASR^PSGON

 +4        IF "^"[X

               SET VALMQUIT=1

               QUIT 

 +5        SET PSJLM=1

           SET PSJSEL=0

           FOR 

               SET PSJSEL=$ORDER(PSGODDD(PSJSEL))

               IF 'PSJSEL!($GET(Y)<0)

                   QUIT 

               FOR PSJSEL1=1:1:$LENGTH(PSGODDD(PSJSEL),",")-1

                   Begin DoDot:1

 +6                    SET PSJORD=$GET(^TMP("PSJON",$JOB,+$PIECE(PSGODDD(PSJSEL),",",PSJSEL1)))

                       IF PSJORD=+PSJORD

                           DO SELECT^PSJOEA

                       IF PSJORD=""!($GET(Y)<0)

                           QUIT 

                       IF PSJORD=+PSJORD

                           QUIT 

                       Begin DoDot:2

 +7                        IF ('$$LS^PSSLOCK(PSGP,PSJORD))

                               QUIT 

 +8                        IF PSJORD=+PSJORD

                               QUIT 

 +9                        SET PSGORD=""

 +10                       IF PSJORD'["U"

                               QUIT 

 +11                       SET ON=PSJORD

                           DO BCMA

 +12                       IF $GET(Y)<0

                               QUIT 

                       End DoDot:2

                   End DoDot:1

 +13       SET VALMBCK="Q"

 +14       KILL PSJLM

 +15       QUIT 

BCMA      ;GET DISPENSE DRUG INFO

 +1        NEW PSBANS,PSBANS1,PSBRPT,PSBSAVE,DA,DIK,DR,DDSFILE,CPSDIEN,CPSDIEN1

 +2        KILL CPSDRGS

 +3        WRITE @IOF

 +4       ;DRUG INFO ALL ACTIVE DISPENSE

 +5        SET CPSDIEN=0

           FOR 

               SET CPSDIEN=$ORDER(^PS(55,DFN,5,+PSJORD,1,"B",CPSDIEN))

               IF CPSDIEN'>0

                   QUIT 

               Begin DoDot:1

 +6                SET CPSDIEN1=0

                   FOR 

                       SET CPSDIEN1=$ORDER(^PS(55,DFN,5,+PSJORD,1,"B",CPSDIEN,CPSDIEN1))

                       IF CPSDIEN1'>0

                           QUIT 

                       Begin DoDot:2

 +7       ;BAIL IF INACTIVE DATE

                           IF $PIECE($GET(^PS(55,DFN,5,+PSJORD,1,CPSDIEN1,0)),U,3)'=""

                               QUIT 

 +8       ;BCMA UNIT GIVE ROUND UP

                           SET CPSDRGS(CPSDIEN)=$JUSTIFY($PIECE($GET(^PS(55,DFN,5,+PSJORD,1,CPSDIEN1,0)),U,2),0,0)

                       End DoDot:2

               End DoDot:1

 +9        SET CPSDIEN=0

           FOR 

               SET CPSDIEN=$ORDER(CPSDRGS(CPSDIEN))

               IF CPSDIEN'>0

                   QUIT 

               DO BL

 +10       QUIT 

BL        ; FILE LABELS

 +1        NEW PSBTYPE,PSBPRT,CPSMAN,CPSEXP,CPSLOT,CPSDOSE

 +2        WRITE @IOF

 +3       ;FROM PSBOBZ

 +4        SET PSBTYPE="BZ"

           DO NEW^PSBO1(.PSBRPT,PSBTYPE)

 +5        IF +PSBRPT(0)<1

               WRITE !,"Error: ",$PIECE(PSBRPT(0),U,2)

               SET DIR(0)="E"

               DO ^DIR

               QUIT 

 +6        SET DA=+PSBRPT(0)

           SET DIE="^PSB(53.69,"

 +7       ;END PSBOBZ 

 +8        SET CPSMAN=$PIECE($GET(^PSDRUG(CPSDIEN,999999924)),U,1)

 +9        SET CPSLOT=$PIECE($GET(^PSDRUG(CPSDIEN,999999924)),U,2)

 +10       SET CPSEXP=$PIECE($GET(^PSDRUG(CPSDIEN,660)),U,9)

 +11       SET CPSDOSE=$PIECE(^PS(55,DFN,5,+PSJORD,.2),U,2)

 +12       SET DR=".31///^S X=CPSDIEN"

           DO ^DIE

 +13       IF $GET(CPSLOT)'=""

               SET DR=".32///^S X=CPSLOT"

               DO ^DIE

 +14       IF $GET(CPSEXP)'=""

               SET DR=".33///^S X=CPSEXP"

               DO ^DIE

 +15       IF $GET(CPSMAN)'=""

               SET DR=".34///^S X=CPSMAN"

               DO ^DIE

 +16       SET DR=".38///^S X=$G(CPSDRGS(CPSDIEN))"

           DO ^DIE

 +17       IF $GET(IOP)'=""

               SET DR=".06///^S X=IOP"

           DO ^DIE

 +18       DO NOW^%DTC

           SET DR=".07///^S X=%"

           DO ^DIE

 +19       SET DR=".12///^S X=DFN"

           DO ^DIE

 +20       SET DR=".39///^S X=CPSDOSE"

           DO ^DIE

 +21      ;BELOW LOGIC FROM PSBOBZ

 +22       SET DR="[PSBO "_PSBTYPE_"]"

           SET DDSFILE=53.69

           DO ^DDS

 +23       IF 'PSBSAVE

               WRITE !,"Cancelling Request..."

               SET DIK="^PSB(53.69,"

               DO ^DIK

               WRITE "Cancelled!"

 +24       IF PSBSAVE

               Begin DoDot:1

 +25               SET IOP=$$GET1^DIQ(53.69,DA_",",.06,"I")

                   SET PSBSIO=0

 +26               WRITE !,"Submitting Your Report Request to TaskMan..."

                   HANG 1

 +27               SET ZTIO=$$GET1^DIQ(53.69,DA_",",.06)

 +28               SET ZTDTH=$PIECE(^PSB(53.69,DA,0),U,7)

 +29               SET ZTDESC="BCMA - "_$$GET1^DIQ(53.69,DA_",",.05)

 +30               SET ZTRTN="DQ^PSBO("_DA_")"

 +31               DO ^%ZTLOAD

 +32               WRITE !,"Submitted!",!,"Your Task Number Is: ",$GET(ZTSK),!

                   HANG 1

               End DoDot:1

 +33       QUIT