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
