PSARDCRD ;BIRM/JMC - Return Drug Credit Report - Detailed ;06/04/08
;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**69**;10/24/97;Build 9
;References to ORDER UNIT file (#51.5) supported by IA #1931
;
;
N PSARDST,PSAOUT,PRINTFLG
S PSAOUT=0
K PAG,^TMP("PSARDCRD1",$J),^TMP("PSARDCRD",$J)
D STATUS I '$D(PSABASTS) G EXIT
I $G(PSAEXCEL)=1 S FIRSTHD=1
S PSARDST="" F S PSARDST=$O(PSABASTS(PSARDST)) Q:PSARDST="" D Q:PSAOUT
. S PSAPHLC1=$P($G(PSAPHLOC),"^",2)
. S (PRINTFLG,PSAOUT)=0,(PSABTCH,PSARDCMF)=""
. U IO D GETDATA Q:PSAOUT
. I '$G(PSAEXCEL),'$G(PRINTFLG) D
. . D HDR W:'$G(PRINTFLG) !!,"*** NO BATCHES FOUND ***",!!! S PRINTFLG=0
D EXIT
Q
;
HDR ; - Prints the Header
N X,DIR,SS,JJ
S PAG=$G(PAG)+1
I PAG>1,$E(IOST)="C" D Q:PSAOUT
. S SS=22-$Y F JJ=1:1:SS W !
. S DIR(0)="E",DIR("A")=" Press ENTER to Continue or ^ to Exit" D ^DIR
. S PSAOUT=$S($D(DIRUT):1,Y:0,1:1)
W @IOF,"Return Drug Credit Report (DETAILED)",?71,"Page: ",$J(PAG,3)
W !,"PHARM LOCATION: ",$E($P(PSAPHLOC,"^",2),1,40),?63,"BATCH #: "_$G(PSABTCH)
W !,"RTN CONTRACTOR: ",$E($G(PSARDCMF),1,31),?$S(PSARDST="AP":57,1:63),"STATUS: ",$G(PSABASTS(PSARDST))
I PSARDST="CA",$G(PSABATCH) D
. W !,"CANCELLED CMTS: ",$E($P($G(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",3),1,31)
. W ?48,$J("CANCELLED BY: "_$E($P($G(^VA(200,+$P($G(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",2),0)),"^"),1,18),32)
W !,"Date Range: "_$$FMTE^XLFDT(PSARDRBD,"2Z")_" THRU "_$$FMTE^XLFDT(PSARDRED,"2Z")
W ?53,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),"2Z")
I PSARDST="PU"!(PSARDST="CO") W !,"Total Batch Credit: $"_$J($S(PSARDST="PU":$G(CREDTOT),PSARDST="CO":$G(CRDTOTCO),1:0),0,2)
S X="",$P(X,"-",80)="-" W !,X
Q
;
STATUS ;Create local array of statuses.
F I=1:1:$L(PSABASTS,",") D
. S PSARDST=$P(PSABASTS,",",I)
. S PSABASTS(PSARDST)=$S(PSARDST="AP":"AWAITING PICKUP",PSARDST="PU":"PICKED UP",PSARDST="CA":"CANCELLED",1:"COMPLETED")
Q
;
EXIT ; KILL VARIABLES AND EXIT
D ^%ZISC
K PSABASTS,CREDTOT,CREDTOT1,DRUGTOT,DRUGTOT1,CRDTOTCO,PSARDST,PSABATCH,PSAPHLOC
K BATTOT,PSARDRBD,PSARDRED,PSARDCMF,CRED,I,DIR,X,PAG,PSADTRNG,PSARDRTP,PSAPHLC1
K PSABTCH,J,XX,MFR,UPC,UPDINV,CREATEBY,CREATEON,CREDSTAT,RTRNRSN,CRED1,X1,X2,X3
K DIRUT,^TMP("PSARDCRD1",$J),^TMP("PSARDCRD",$J),FIRSTHD,PSAEXCEL
Q
;
GETDATA ; Retrieve data for printing
N PSABATCH S PSABATCH="",PSAPHLC1=$P(PSAPHLOC,"^")
F S PSABATCH=$O(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH)) Q:PSABATCH="" D Q:PSAOUT
. Q:'$D(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH))
. I $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,1,"I")'=PSARDST Q
. I PSARDST'="CA",$P($$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,$S(PSARDST="AP":3,PSARDST="CO":9,PSARDST="PU":2,1:3),"I"),".")<PSARDRBD Q
. I PSARDST'="CA",$P($$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,$S(PSARDST="AP":3,PSARDST="CO":9,PSARDST="PU":2,1:3),"I"),".")>PSARDRED Q
. I PSARDST="CA",$P($P(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN"),"^"),".")<PSARDRBD Q
. I PSARDST="CA",$P($P(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN"),"^"),".")>PSARDRED Q
. S PSABTCH=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,.01)
. S PSARDCMF=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,4)
. D ITEMS Q:PSAOUT
. I $G(PSAEXCEL)=0,$D(^TMP("PSARDCRD1",$J)) D HDR Q:PSAOUT D PRINT
. I $G(PSAEXCEL)=1,$D(^TMP("PSARDCRD1",$J)) D HDR2,PRINT2 Q:PSAOUT
Q
;
ITEMS ; Retrieve individual drug entries that match the criteria for the report.
I $G(PSAPHLC1)=""!($G(PSABATCH)="") Q
N I,J,DRUGNAM,X,XX S (DRUGNAM,I,J,X,XX)="",$P(X," ",80)=" ",$P(XX,"-",80)="-"
F S I=$O(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"ITM",I)) Q:I="" D
. S DRUGNAM=$$GET1^DIQ(58.3511,I_","_PSABATCH_","_PSAPHLC1,.01) I DRUGNAM="" Q
. S ^TMP("PSARDCRD",$J,DRUGNAM,I)=""
S DRUGNAM="",(SEQ,ITEM,CREDTOT,CRDTOTCO)=0
F S DRUGNAM=$O(^TMP("PSARDCRD",$J,DRUGNAM)) Q:DRUGNAM="" D
. F S ITEM=$O(^TMP("PSARDCRD",$J,DRUGNAM,ITEM)) Q:ITEM="" D
. . S SEQ=SEQ+1
. . D GETS^DIQ(58.3511,ITEM_","_PSABATCH_","_PSAPHLC1_",","*","IE","FLDS")
. . M DATA=FLDS(58.3511,ITEM_","_PSABATCH_","_PSAPHLC1_",")
. . S DRUG=$E(DATA(.01,"E"),1,25),NDC=DATA(3,"E"),QTY=DATA(6,"E"),RTNQTY=DATA(17,"E")
. . S MFR=DATA(2,"E"),EXPDAT=$$FMTE^XLFDT(DATA(9,"I"),"2Z")
. . S ORDUNT=DATA(5,"I") I ORDUNT'="" S ORDUNT=$$GET1^DIQ(51.5,ORDUNT,.02,"I")
. . S UPC=DATA(4,"E"),CREATEBY=$E(DATA(16,"E"),1,21),CREATEON=$$FMTE^XLFDT($P(DATA(1,"I"),"."),"2Z")
. . S UPDINV=DATA(14,"E") I UPDINV="" S UPDINV="NO"
. . S RTRNRSN=$E(DATA(15,"E"),1,21)
. . S DISPUNT=$E(DATA(8,"E"),1,15)
. . S CREDSTAT=DATA(10,"E") I CREDSTAT="" S CREDSTAT="**N/A**"
. . S CRED=$TR($S(CREDSTAT="ACTUAL":DATA(12,"I"),PSARDST="CO":DATA(12,"I"),PSARDST="PU":DATA(11,"I"),1:""),",")
. . I $G(PSAEXCEL)=0 D
. . . S $E(LINE1,1)=$J("Drug: ",15)_DRUG,$E(LINE1,45)=$J("Credit Status: ",15)_CREDSTAT
. . . S $E(LINE2,1)=$J("Manufacturer: ",15)_MFR,$E(LINE2,45)=$J("Credit Amount: "_$S(CRED="":"",1:"$"),15)_$S(CRED="":"",1:$J(CRED,0,2))_$S(CRED="":"",CREDSTAT="ACTUAL":" (ACTUAL)",PSARDST="CO":" (ACTUAL)",PSARDST="PU":" (ESTIMATED)",1:"")
. . . S $E(LINE3,1)=$J("NDC: ",15)_NDC,$E(LINE3,45)=$J("Exp. Date: ",15)_EXPDAT
. . . S $E(LINE4,1)=$J("Rtrn Ord Qty: ",15)_QTY_" "_ORDUNT,$E(LINE4,45)=$J("Created By: ",15)_CREATEBY
. . . S $E(LINE5,1)=$J("Rtrn Disp Qty: ",15)_RTNQTY_" "_DISPUNT,$E(LINE5,45)=$J("Created On: ",15)_CREATEON
. . . S $E(LINE6,1)=$J("UPC: ",15)_UPC,$E(LINE6,45)=$J("Upd Inventory: ",15)_UPDINV
. . . S $E(LINE7,1)=$J("Return Rsn: ",15)_RTRNRSN
. . . S $E(LINE8,1)=XX
. . . S LINE(PSARDST,SEQ,1)=LINE1
. . . S LINE(PSARDST,SEQ,2)=LINE2
. . . S LINE(PSARDST,SEQ,3)=LINE3
. . . S LINE(PSARDST,SEQ,4)=LINE4
. . . S LINE(PSARDST,SEQ,5)=LINE5
. . . S LINE(PSARDST,SEQ,6)=LINE6
. . . S LINE(PSARDST,SEQ,7)=LINE7
. . . S LINE(PSARDST,SEQ,8)=LINE8
. . . I PSARDST="CO" S CRDTOTCO=CRDTOTCO+$G(CRED)
. . . I PSARDST="PU" S CREDTOT=CREDTOT+$G(CRED)
. . I $G(PSAEXCEL)=1 D
. . . I PSARDST'="CA" S EXPDAT1=$$FMTE^XLFDT($P($$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,$S(PSARDST="PU":2,PSARDST="CO":9,1:3),"I"),"."),"2Z")
. . . I PSARDST="CA" S EXPDAT1=$$FMTE^XLFDT($P($P($G(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^"),"."),"2Z")
. . . S CREATEON=$$FMTE^XLFDT(DATA(1,"I"),"2ZP")
. . . S LINE(SEQ)=$P(PSAPHLOC,"^",2)_"^"_PSABTCH_"^"_PSABASTS(PSARDST)_"^"_EXPDAT1_"^"_PSARDCMF_"^"_DRUG_"^"_NDC_"^"_QTY_" "_ORDUNT_"^"_RTNQTY_" "_DISPUNT_"^"_UPDINV_"^"_$S(CRED="":"",1:$J(CRED,0,2))_"^"
. . . S LINE(SEQ)=LINE(SEQ)_MFR_"^"_UPC_"^"_RTRNRSN_"^"_CREDSTAT_"^"_$S(DATA(11,"I")="":"",1:$J(DATA(11,"I"),0,2))_"^"_EXPDAT_"^"_CREATEBY_"^"_CREATEON
. . . I PSARDST="CA" S LINE(SEQ)=LINE(SEQ)_"^"_$E($P($G(^VA(200,+$P($G(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",2),0)),"^"),1,18)_"^"_$E($P($G(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",3),1,25)
. . M ^TMP("PSARDCRD1",$J)=LINE
. . K LINE,LINE1,LINE2,LINE3,LINE4,LINE5,LINE6,LINE7,LINE8,DATA
K LINE,DATA,FLDS,^TMP("PSARDCRD",$J),LINE1,SEQ,DRUGNAM,ITEM,DRUG,NDC,QTY,DSPUNT,EXPDAT,ORDUNT,UPDINV,EXPDAT1,RTNQTY,DISPUNT
Q
;
PRINT ; Print the individual drug entries that match the criteria for the report.
Q:PSAOUT
N X1,X2,X3
S X1="",(X2,X3)=0
F S X1=$O(^TMP("PSARDCRD1",$J,X1)) Q:X1="" D Q:PSAOUT
. F S X2=$O(^TMP("PSARDCRD1",$J,X1,X2)) Q:X2="" D Q:PSAOUT
. . I $Y>(IOSL-9) D HDR Q:PSAOUT
. . F S X3=$O(^TMP("PSARDCRD1",$J,X1,X2,X3)) Q:X3="" D Q:PSAOUT
. . . W !,^TMP("PSARDCRD1",$J,X1,X2,X3)
. . . K ^TMP("PSARDCRD1",$J,X1,X2,X3)
S PRINTFLG=1
W !
Q
HDR2 ;
I $G(FIRSTHD)=1 D S FIRSTHD=0
. W "PHARM LOC^BATCH #^BATCH STAT^DATE COMPLETED/CANCELLED/PICKED UP^RETURN CONTRACTOR^"
. W "DRUG^NDC^RTRN ORD QTY^RTRN DISP QTY^UPD INVENTORY^ACTUAL CRED^DRUG MFR^DRUG UPC^RTRN RSN^"
. W "CRED STAT^ESTD CRED^DRUG EXPIRE DATE^CREATED BY^CREATED ON^CANCELELD BY^CANCELLED CMTS"
Q
PRINT2 ; Spreadsheet format
Q:PSAOUT
N X1
S X1=""
F S X1=$O(^TMP("PSARDCRD1",$J,X1)) Q:X1="" D Q:PSAOUT
. W !,^TMP("PSARDCRD1",$J,X1)
. K ^TMP("PSARDCRD1",$J,X1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSARDCRD 8030 printed Dec 13, 2024@01:50:24 Page 2
PSARDCRD ;BIRM/JMC - Return Drug Credit Report - Detailed ;06/04/08
+1 ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**69**;10/24/97;Build 9
+2 ;References to ORDER UNIT file (#51.5) supported by IA #1931
+3 ;
+4 ;
+5 NEW PSARDST,PSAOUT,PRINTFLG
+6 SET PSAOUT=0
+7 KILL PAG,^TMP("PSARDCRD1",$JOB),^TMP("PSARDCRD",$JOB)
+8 DO STATUS
IF '$DATA(PSABASTS)
GOTO EXIT
+9 IF $GET(PSAEXCEL)=1
SET FIRSTHD=1
+10 SET PSARDST=""
FOR
SET PSARDST=$ORDER(PSABASTS(PSARDST))
if PSARDST=""
QUIT
Begin DoDot:1
+11 SET PSAPHLC1=$PIECE($GET(PSAPHLOC),"^",2)
+12 SET (PRINTFLG,PSAOUT)=0
SET (PSABTCH,PSARDCMF)=""
+13 USE IO
DO GETDATA
if PSAOUT
QUIT
+14 IF '$GET(PSAEXCEL)
IF '$GET(PRINTFLG)
Begin DoDot:2
+15 DO HDR
if '$GET(PRINTFLG)
WRITE !!,"*** NO BATCHES FOUND ***",!!!
SET PRINTFLG=0
End DoDot:2
End DoDot:1
if PSAOUT
QUIT
+16 DO EXIT
+17 QUIT
+18 ;
HDR ; - Prints the Header
+1 NEW X,DIR,SS,JJ
+2 SET PAG=$GET(PAG)+1
+3 IF PAG>1
IF $EXTRACT(IOST)="C"
Begin DoDot:1
+4 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+5 SET DIR(0)="E"
SET DIR("A")=" Press ENTER to Continue or ^ to Exit"
DO ^DIR
+6 SET PSAOUT=$SELECT($DATA(DIRUT):1,Y:0,1:1)
End DoDot:1
if PSAOUT
QUIT
+7 WRITE @IOF,"Return Drug Credit Report (DETAILED)",?71,"Page: ",$JUSTIFY(PAG,3)
+8 WRITE !,"PHARM LOCATION: ",$EXTRACT($PIECE(PSAPHLOC,"^",2),1,40),?63,"BATCH #: "_$GET(PSABTCH)
+9 WRITE !,"RTN CONTRACTOR: ",$EXTRACT($GET(PSARDCMF),1,31),?$SELECT(PSARDST="AP":57,1:63),"STATUS: ",$GET(PSABASTS(PSARDST))
+10 IF PSARDST="CA"
IF $GET(PSABATCH)
Begin DoDot:1
+11 WRITE !,"CANCELLED CMTS: ",$EXTRACT($PIECE($GET(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",3),1,31)
+12 WRITE ?48,$JUSTIFY("CANCELLED BY: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE($GET(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",2),0)),"^"),1,18),32)
End DoDot:1
+13 WRITE !,"Date Range: "_$$FMTE^XLFDT(PSARDRBD,"2Z")_" THRU "_$$FMTE^XLFDT(PSARDRED,"2Z")
+14 WRITE ?53,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),"2Z")
+15 IF PSARDST="PU"!(PSARDST="CO")
WRITE !,"Total Batch Credit: $"_$JUSTIFY($SELECT(PSARDST="PU":$GET(CREDTOT),PSARDST="CO":$GET(CRDTOTCO),1:0),0,2)
+16 SET X=""
SET $PIECE(X,"-",80)="-"
WRITE !,X
+17 QUIT
+18 ;
STATUS ;Create local array of statuses.
+1 FOR I=1:1:$LENGTH(PSABASTS,",")
Begin DoDot:1
+2 SET PSARDST=$PIECE(PSABASTS,",",I)
+3 SET PSABASTS(PSARDST)=$SELECT(PSARDST="AP":"AWAITING PICKUP",PSARDST="PU":"PICKED UP",PSARDST="CA":"CANCELLED",1:"COMPLETED")
End DoDot:1
+4 QUIT
+5 ;
EXIT ; KILL VARIABLES AND EXIT
+1 DO ^%ZISC
+2 KILL PSABASTS,CREDTOT,CREDTOT1,DRUGTOT,DRUGTOT1,CRDTOTCO,PSARDST,PSABATCH,PSAPHLOC
+3 KILL BATTOT,PSARDRBD,PSARDRED,PSARDCMF,CRED,I,DIR,X,PAG,PSADTRNG,PSARDRTP,PSAPHLC1
+4 KILL PSABTCH,J,XX,MFR,UPC,UPDINV,CREATEBY,CREATEON,CREDSTAT,RTRNRSN,CRED1,X1,X2,X3
+5 KILL DIRUT,^TMP("PSARDCRD1",$JOB),^TMP("PSARDCRD",$JOB),FIRSTHD,PSAEXCEL
+6 QUIT
+7 ;
GETDATA ; Retrieve data for printing
+1 NEW PSABATCH
SET PSABATCH=""
SET PSAPHLC1=$PIECE(PSAPHLOC,"^")
+2 FOR
SET PSABATCH=$ORDER(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH))
if PSABATCH=""
QUIT
Begin DoDot:1
+3 if '$DATA(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH))
QUIT
+4 IF $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,1,"I")'=PSARDST
QUIT
+5 IF PSARDST'="CA"
IF $PIECE($$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,$SELECT(PSARDST="AP":3,PSARDST="CO":9,PSARDST="PU":2,1:3),"I"),".")<PSARDRBD
QUIT
+6 IF PSARDST'="CA"
IF $PIECE($$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,$SELECT(PSARDST="AP":3,PSARDST="CO":9,PSARDST="PU":2,1:3),"I"),".")>PSARDRED
QUIT
+7 IF PSARDST="CA"
IF $PIECE($PIECE(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN"),"^"),".")<PSARDRBD
QUIT
+8 IF PSARDST="CA"
IF $PIECE($PIECE(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN"),"^"),".")>PSARDRED
QUIT
+9 SET PSABTCH=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,.01)
+10 SET PSARDCMF=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,4)
+11 DO ITEMS
if PSAOUT
QUIT
+12 IF $GET(PSAEXCEL)=0
IF $DATA(^TMP("PSARDCRD1",$JOB))
DO HDR
if PSAOUT
QUIT
DO PRINT
+13 IF $GET(PSAEXCEL)=1
IF $DATA(^TMP("PSARDCRD1",$JOB))
DO HDR2
DO PRINT2
if PSAOUT
QUIT
End DoDot:1
if PSAOUT
QUIT
+14 QUIT
+15 ;
ITEMS ; Retrieve individual drug entries that match the criteria for the report.
+1 IF $GET(PSAPHLC1)=""!($GET(PSABATCH)="")
QUIT
+2 NEW I,J,DRUGNAM,X,XX
SET (DRUGNAM,I,J,X,XX)=""
SET $PIECE(X," ",80)=" "
SET $PIECE(XX,"-",80)="-"
+3 FOR
SET I=$ORDER(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"ITM",I))
if I=""
QUIT
Begin DoDot:1
+4 SET DRUGNAM=$$GET1^DIQ(58.3511,I_","_PSABATCH_","_PSAPHLC1,.01)
IF DRUGNAM=""
QUIT
+5 SET ^TMP("PSARDCRD",$JOB,DRUGNAM,I)=""
End DoDot:1
+6 SET DRUGNAM=""
SET (SEQ,ITEM,CREDTOT,CRDTOTCO)=0
+7 FOR
SET DRUGNAM=$ORDER(^TMP("PSARDCRD",$JOB,DRUGNAM))
if DRUGNAM=""
QUIT
Begin DoDot:1
+8 FOR
SET ITEM=$ORDER(^TMP("PSARDCRD",$JOB,DRUGNAM,ITEM))
if ITEM=""
QUIT
Begin DoDot:2
+9 SET SEQ=SEQ+1
+10 DO GETS^DIQ(58.3511,ITEM_","_PSABATCH_","_PSAPHLC1_",","*","IE","FLDS")
+11 MERGE DATA=FLDS(58.3511,ITEM_","_PSABATCH_","_PSAPHLC1_",")
+12 SET DRUG=$EXTRACT(DATA(.01,"E"),1,25)
SET NDC=DATA(3,"E")
SET QTY=DATA(6,"E")
SET RTNQTY=DATA(17,"E")
+13 SET MFR=DATA(2,"E")
SET EXPDAT=$$FMTE^XLFDT(DATA(9,"I"),"2Z")
+14 SET ORDUNT=DATA(5,"I")
IF ORDUNT'=""
SET ORDUNT=$$GET1^DIQ(51.5,ORDUNT,.02,"I")
+15 SET UPC=DATA(4,"E")
SET CREATEBY=$EXTRACT(DATA(16,"E"),1,21)
SET CREATEON=$$FMTE^XLFDT($PIECE(DATA(1,"I"),"."),"2Z")
+16 SET UPDINV=DATA(14,"E")
IF UPDINV=""
SET UPDINV="NO"
+17 SET RTRNRSN=$EXTRACT(DATA(15,"E"),1,21)
+18 SET DISPUNT=$EXTRACT(DATA(8,"E"),1,15)
+19 SET CREDSTAT=DATA(10,"E")
IF CREDSTAT=""
SET CREDSTAT="**N/A**"
+20 SET CRED=$TRANSLATE($SELECT(CREDSTAT="ACTUAL":DATA(12,"I"),PSARDST="CO":DATA(12,"I"),PSARDST="PU":DATA(11,"I"),1:""),",")
+21 IF $GET(PSAEXCEL)=0
Begin DoDot:3
+22 SET $EXTRACT(LINE1,1)=$JUSTIFY("Drug: ",15)_DRUG
SET $EXTRACT(LINE1,45)=$JUSTIFY("Credit Status: ",15)_CREDSTAT
+23 SET $EXTRACT(LINE2,1)=$JUSTIFY("Manufacturer: ",15)_MFR
SET $EXTRACT(LINE2,45)=$JUSTIFY("Credit Amount: "_$SELECT(CRED="":"",1:"$"),15)_$SELECT(CRED="":"",1:$JUSTIFY(CRED,0,2))_$SELECT(CRED="":"",CREDSTAT="ACTUAL":" (ACTUAL)",PSARDST="CO":" (ACTUAL)",PSARDST="PU":" (ESTIMATED
)",1:"")
+24 SET $EXTRACT(LINE3,1)=$JUSTIFY("NDC: ",15)_NDC
SET $EXTRACT(LINE3,45)=$JUSTIFY("Exp. Date: ",15)_EXPDAT
+25 SET $EXTRACT(LINE4,1)=$JUSTIFY("Rtrn Ord Qty: ",15)_QTY_" "_ORDUNT
SET $EXTRACT(LINE4,45)=$JUSTIFY("Created By: ",15)_CREATEBY
+26 SET $EXTRACT(LINE5,1)=$JUSTIFY("Rtrn Disp Qty: ",15)_RTNQTY_" "_DISPUNT
SET $EXTRACT(LINE5,45)=$JUSTIFY("Created On: ",15)_CREATEON
+27 SET $EXTRACT(LINE6,1)=$JUSTIFY("UPC: ",15)_UPC
SET $EXTRACT(LINE6,45)=$JUSTIFY("Upd Inventory: ",15)_UPDINV
+28 SET $EXTRACT(LINE7,1)=$JUSTIFY("Return Rsn: ",15)_RTRNRSN
+29 SET $EXTRACT(LINE8,1)=XX
+30 SET LINE(PSARDST,SEQ,1)=LINE1
+31 SET LINE(PSARDST,SEQ,2)=LINE2
+32 SET LINE(PSARDST,SEQ,3)=LINE3
+33 SET LINE(PSARDST,SEQ,4)=LINE4
+34 SET LINE(PSARDST,SEQ,5)=LINE5
+35 SET LINE(PSARDST,SEQ,6)=LINE6
+36 SET LINE(PSARDST,SEQ,7)=LINE7
+37 SET LINE(PSARDST,SEQ,8)=LINE8
+38 IF PSARDST="CO"
SET CRDTOTCO=CRDTOTCO+$GET(CRED)
+39 IF PSARDST="PU"
SET CREDTOT=CREDTOT+$GET(CRED)
End DoDot:3
+40 IF $GET(PSAEXCEL)=1
Begin DoDot:3
+41 IF PSARDST'="CA"
SET EXPDAT1=$$FMTE^XLFDT($PIECE($$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,$SELECT(PSARDST="PU":2,PSARDST="CO":9,1:3),"I"),"."),"2Z")
+42 IF PSARDST="CA"
SET EXPDAT1=$$FMTE^XLFDT($PIECE($PIECE($GET(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^"),"."),"2Z")
+43 SET CREATEON=$$FMTE^XLFDT(DATA(1,"I"),"2ZP")
+44 SET LINE(SEQ)=$PIECE(PSAPHLOC,"^",2)_"^"_PSABTCH_"^"_PSABASTS(PSARDST)_"^"_EXPDAT1_"^"_PSARDCMF_"^"_DRUG_"^"_NDC_"^"_QTY_" "_ORDUNT_"^"_RTNQTY_" "_DISPUNT_"^"_UPDINV_"^"_$SELECT(CRED="":"",1:$JUSTIFY(CRED,0,2))_"^"
+45 SET LINE(SEQ)=LINE(SEQ)_MFR_"^"_UPC_"^"_RTRNRSN_"^"_CREDSTAT_"^"_$SELECT(DATA(11,"I")="":"",1:$JUSTIFY(DATA(11,"I"),0,2))_"^"_EXPDAT_"^"_CREATEBY_"^"_CREATEON
+46 IF PSARDST="CA"
SET LINE(SEQ)=LINE(SEQ)_"^"_$EXTRACT($PIECE($GET(^VA(200,+$PIECE($GET(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",2),0)),"^"),1,18)_"^"_$EXTRACT($PIECE($GET(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",3),1,25)
End DoDot:3
+47 MERGE ^TMP("PSARDCRD1",$JOB)=LINE
+48 KILL LINE,LINE1,LINE2,LINE3,LINE4,LINE5,LINE6,LINE7,LINE8,DATA
End DoDot:2
End DoDot:1
+49 KILL LINE,DATA,FLDS,^TMP("PSARDCRD",$JOB),LINE1,SEQ,DRUGNAM,ITEM,DRUG,NDC,QTY,DSPUNT,EXPDAT,ORDUNT,UPDINV,EXPDAT1,RTNQTY,DISPUNT
+50 QUIT
+51 ;
PRINT ; Print the individual drug entries that match the criteria for the report.
+1 if PSAOUT
QUIT
+2 NEW X1,X2,X3
+3 SET X1=""
SET (X2,X3)=0
+4 FOR
SET X1=$ORDER(^TMP("PSARDCRD1",$JOB,X1))
if X1=""
QUIT
Begin DoDot:1
+5 FOR
SET X2=$ORDER(^TMP("PSARDCRD1",$JOB,X1,X2))
if X2=""
QUIT
Begin DoDot:2
+6 IF $Y>(IOSL-9)
DO HDR
if PSAOUT
QUIT
+7 FOR
SET X3=$ORDER(^TMP("PSARDCRD1",$JOB,X1,X2,X3))
if X3=""
QUIT
Begin DoDot:3
+8 WRITE !,^TMP("PSARDCRD1",$JOB,X1,X2,X3)
+9 KILL ^TMP("PSARDCRD1",$JOB,X1,X2,X3)
End DoDot:3
if PSAOUT
QUIT
End DoDot:2
if PSAOUT
QUIT
End DoDot:1
if PSAOUT
QUIT
+10 SET PRINTFLG=1
+11 WRITE !
+12 QUIT
HDR2 ;
+1 IF $GET(FIRSTHD)=1
Begin DoDot:1
+2 WRITE "PHARM LOC^BATCH #^BATCH STAT^DATE COMPLETED/CANCELLED/PICKED UP^RETURN CONTRACTOR^"
+3 WRITE "DRUG^NDC^RTRN ORD QTY^RTRN DISP QTY^UPD INVENTORY^ACTUAL CRED^DRUG MFR^DRUG UPC^RTRN RSN^"
+4 WRITE "CRED STAT^ESTD CRED^DRUG EXPIRE DATE^CREATED BY^CREATED ON^CANCELELD BY^CANCELLED CMTS"
End DoDot:1
SET FIRSTHD=0
+5 QUIT
PRINT2 ; Spreadsheet format
+1 if PSAOUT
QUIT
+2 NEW X1
+3 SET X1=""
+4 FOR
SET X1=$ORDER(^TMP("PSARDCRD1",$JOB,X1))
if X1=""
QUIT
Begin DoDot:1
+5 WRITE !,^TMP("PSARDCRD1",$JOB,X1)
+6 KILL ^TMP("PSARDCRD1",$JOB,X1)
End DoDot:1
if PSAOUT
QUIT
+7 QUIT
