PSARDCRS ;BIRM/JMC - Return Drug Credit Report - Summary ;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
K PAG,^TMP("PSARDCRS",$J),^TMP("PSARDCRS1",$J)
S PSAOUT=0 I $G(PSAEXCEL)=1 S FIRSTHD=1
D STATUS I '$D(PSABASTS) G EXIT
S PSARDST="" F S PSARDST=$O(PSABASTS(PSARDST)) Q:PSARDST="" D Q:PSAOUT
. S PSAPHLC1=$P($G(PSAPHLOC),"^",2)
. U IO
. I $G(PSAEXCEL)=0 D
. . D HDR Q:PSAOUT
. . D GETDATA
. . W:'$G(PRINTFLG) !!,"*** NO BATCHES FOUND ***",!!! S PRINTFLG=0
. I $G(PSAEXCEL)=1 D GETDATA Q:PSAOUT
D EXIT
Q
HDR ; - Prints the Header
N X,SS,DIR,JJ
S PAG=$G(PAG)+1
;I PAG>1,'$G(PRINTFLG) D
;. W !!,"*** NO BATCHES FOUND ***",!!!
I PAG>1,$E(IOST)="C" D I PSAOUT Q
. S SS=22-$Y F JJ=1:1:SS W !
. N DIR 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 (SUMMARY)",?71,"Page: ",$J(PAG,3)
W !,"PHARM LOCATION: ",$E($P(PSAPHLOC,"^",2),1,31),?$S(PSARDST="AP":57,1:63),"STATUS: ",$G(PSABASTS(PSARDST))
W !,"Date Range: "_$$FMTE^XLFDT(PSARDRBD,"2Z")_" THRU "_$$FMTE^XLFDT(PSARDRED,"2Z")
W ?53,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),"2Z")
S X="",$P(X,"-",80)="-" W !,X
W !,?39,$J("ORD",6),?46,"ORDER",?54,$J("DISP",6),?61,"DISP",?68,"UPD"
I PSARDST="PU"!(PSARDST="CO") W ?73,"ACTUAL"
W !,"DRUG (NDC)",?39,$J("QTY",6),?46,"UNIT",?54,$J("QTY",6),?61,"UNIT",?68,"INV"
I PSARDST="PU"!(PSARDST="CO") W ?73,"CREDIT$"
W !,X
S PRINTFLG=0
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,EXPDAT,XX,Y,X,TMPBAT,TMPBAT1,TOT
K BATTOT,PSARDRBD,PSARDRED,PSARDCMF,CRED,I,DIR,X,PAG,PSADTRNG,PSARDRTP,PSAPHLC1
K PSABTCH,PSASCRL,CRDTOTC1,DIRUT,^TMP("PSARDCRS1",$J),^TMP("PSARDCRS",$J),FIRST,FIRSTHD,PSAEXCEL
Q
GETDATA ; Retrieve data for printing
N PSABATCH S PSABATCH=0,PSAPHLC1=$P(PSAPHLOC,"^"),(BATTOT,CREDTOT1,DRUGTOT1,CRDTOTC1)=0
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 PSARDCMF=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,4)
. S BATTOT=BATTOT+1
. D ITEMS I PSAOUT Q
. ;I '$G(PSAEXCEL),$D(^TMP("PSARDCRS1",$J)) D PRINT S PRINTFLG=1 Q:PSAOUT
. I '$G(PSAEXCEL) D PRINT S PRINTFLG=1 Q:PSAOUT
. I $G(PSAEXCEL)=1,$D(^TMP("PSARDCRS1",$J)) D PRINT2 Q:PSAOUT
. I PSARDST="PU" S DRUGTOT1=DRUGTOT1+DRUGTOT,CREDTOT1=CREDTOT1+CREDTOT
. I PSARDST="CO" S CRDTOTC1=CRDTOTC1+CRDTOTCO
Q:PSAOUT
Q:$G(PSAEXCEL)=1
I PSARDST="PU",DRUGTOT1>0 W !,"TOTALS: "_$G(BATTOT)_" Batch"_$S($G(BATTOT)>1:"es",1:"")_", "_$G(DRUGTOT1)_" Drug"_$S($G(DRUGTOT1)>1:"s",1:"")
I (PSARDST="PU"&($G(CREDTOT1)>0))!(PSARDST="CO"&(($G(CRDTOTC1))>0)) W !,"CREDIT TOTAL: $"_$S(PSARDST="CO":$J($G(CRDTOTC1),0,2),PSARDST="PU":$J($G(CREDTOT1),0,2),1:"")
Q
;
ITEMS ; Retrieve individual drug entries that match the criteria for the report.
I $G(PSAPHLC1)=""!($G(PSABATCH)="") Q
N DRUGNAM S (DRUGNAM,I)="",(I,DRUGTOT)=0
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("PSARDCRS",$J,DRUGNAM,I)=""
S DRUGNAM="",(SEQ,ITEM,CREDTOT,CRDTOTCO)=0
F S DRUGNAM=$O(^TMP("PSARDCRS",$J,DRUGNAM)) Q:DRUGNAM="" D
. F S ITEM=$O(^TMP("PSARDCRS",$J,DRUGNAM,ITEM)) Q:ITEM="" D
. . S SEQ=SEQ+1
. . D GETS^DIQ(58.3511,ITEM_","_PSABATCH_","_PSAPHLC1_",","*","IE","FLDS")
. . K DATA M DATA=FLDS(58.3511,ITEM_","_PSABATCH_","_PSAPHLC1_",")
. . S DRUG=$E(DATA(.01,"E"),1,20),NDC=DATA(3,"E"),QTY=DATA(6,"E")
. . S DISPUNT=$E(DATA(8,"E"),1,6)
. . S ORDUNT=DATA(5,"I") I ORDUNT S ORDUNT=$E($$GET1^DIQ(51.5,ORDUNT,.02,"E"),1,6)
. . S UPDINV=DATA(14,"E") I UPDINV="" S UPDINV="NO"
. . S RTRNQTY=DATA(17,"E")
. . S CRED=$TR($S(DATA(10,"E")="ACTUAL":DATA(12,"I"),PSARDST="CO":DATA(12,"I"),PSARDST="PU":DATA(11,"I"),1:""),",")
. . S $E(LINE,1)=DRUG_" ("_NDC_")"
. . S $E(LINE,39)=$J(QTY,7),$E(LINE,47)=ORDUNT,$E(LINE,54)=$J(RTRNQTY,7),$E(LINE,62)=DISPUNT
. . S $E(LINE,69)=UPDINV,$E(LINE,73)=$S(PSARDST'="PU"&(PSARDST'="CO"):"",1:$J($J(+CRED,0,2),8))
. . I $G(PSAEXCEL)=0 S LINE1(SEQ)=LINE
. . I $G(PSAEXCEL)=1 D
. . . I PSARDST'="CA" S EXPDAT=$$FMTE^XLFDT($P($$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,$S(PSARDST="PU":2,PSARDST="CO":9,1:3),"I"),"."),"2Z")
. . . I PSARDST="CA" S EXPDAT=$$FMTE^XLFDT($P($P($G(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^"),"."),"2Z")
. . . S TMPBAT=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,.01)
. . . S LINE1(SEQ)=$P(PSAPHLOC,"^",2)_"^"_TMPBAT_"^"_PSABASTS(PSARDST)_"^"_EXPDAT_"^"_PSARDCMF_"^"_DRUG_"^"_NDC_"^"_QTY_"^"_ORDUNT_"^"_RTRNQTY_"^"_DISPUNT_"^"_UPDINV_"^"_$J(+CRED,0,2)
. . . I PSARDST="CA" S LINE1(SEQ)=LINE1(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)
. . I PSARDST="CO" S CRDTOTCO=CRDTOTCO+$G(CRED)
. . I PSARDST="PU" S CREDTOT=CREDTOT+$G(CRED),DRUGTOT=DRUGTOT+1
. . K LINE
. . M ^TMP("PSARDCRS1",$J)=LINE1
. . S ^TMP("PSARDCRS1",$J,"A")=SEQ
K LINE,DATA,FLDS,^TMP("PSARDCRS",$J),LINE1,SEQ,DRUGNAM,ITEM,DRUG,NDC,QTY,DISPUNT,EXPDAT,ORDUNT,UPDINV,TMPBAT,RTRNQTY
Q
PRINT ; Print the individual drug entries that match the criteria for the report.
Q:PSAOUT
N I,FIRST
S TMPBAT1="",(I,PSASCRL)=0,FIRST=1,TMPBAT=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,.01),TOT=$G(^TMP("PSARDCRS1",$J,"A"))
I PSARDST'="CA" S EXPDAT=$$FMTE^XLFDT($P($$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,$S(PSARDST="PU":2,PSARDST="CO":9,1:3),"I"),"."),"2Z")
I PSARDST="CA" S EXPDAT=$$FMTE^XLFDT($P($P($G(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^"),"."),"2Z")
I $Y>(IOSL-6) D HDR Q:PSAOUT
D:'$D(^TMP("PSARDCRS1",$J)) PRTLINE("") ;,PRTFTR()
F S I=$O(^TMP("PSARDCRS1",$J,I)) Q:I="" D Q:PSAOUT
. I $Y>(IOSL-6) D HDR Q:PSAOUT I I<TOT!(I=TOT) S TMPBAT1=TMPBAT_" (Contd.)",PSASCRL=1
. D PRTLINE(^TMP("PSARDCRS1",$J,I))
. K ^TMP("PSARDCRS1",$J,I)
;W !
Q:PSAOUT
D PRTFTR()
K TMPBAT,TMPBAT1,TOT
Q
;
PRTFTR() ; Print Footer
I PSARDST="CO"!(PSARDST="PU") D
. W !?72,"========"
. W !?25,"NUMBER OF ITEMS: ",+$G(TOT),?56,"BATCH TOTAL: "
. W ?72,$J($S(PSARDST="CO":"$"_$J($G(CRDTOTCO),0,2),1:"$"_$J($G(CREDTOT),0,2)),8)
E D
. W !?25,"NUMBER OF ITEMS: ",+$G(TOT)
W !
Q
;
PRTLINE(LINE) ; Prints an Item line
I 'FIRST,PSASCRL D
. W !,"Batch #: "_TMPBAT1
. W " "_$S(PSARDST="CA":"Date Cancelled: ",PSARDST="PU":"Date Picked Up: ",PSARDST="CO":"Date Completed: ",1:"Date Entered: ")_EXPDAT
. W " - "_$E(PSARDCMF,1,22)
. K TMPBAT1
. S PSASCRL=0
I FIRST D
. W !,"Batch #: "_TMPBAT S (PSASCRL,FIRST)=0
. W " "_$S(PSARDST="CA":"Date Cancelled: ",PSARDST="PU":"Date Picked Up: ",PSARDST="CO":"Date Completed: ",1:"Date Entered: ")_EXPDAT
. W " - "_$E(PSARDCMF,1,29)
. I PSARDST="CA" W !,"Cancelled By: "_$E($P($G(^VA(200,+$P($G(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",2),0)),"^"),1,18)_" "_"Cancelled Comments: "_$E($P($G(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",3),1,25)
I I'="A",LINE'="" W !,LINE
Q
PRINT2 ; Spreadsheet format
N I
S I=""
I $G(FIRSTHD)=1 D S FIRSTHD=0
. W "PHARM LOC^BATCH #^BATCH STATUS^DATE COMPLETED/CANCELLED/PICKED UP"
. W "^RETURN CONTRACTOR^DRUG^NDC^ORD QTY^ORDER UNIT^DISP QTY^DISP UNIT^UPDATE INVENTORY^ACTUAL CREDIT^CANCELLED BY^CANCELLED CMTS"
F S I=$O(^TMP("PSARDCRS1",$J,I)) Q:I="" D Q:PSAOUT
. I I'="A" W !,^TMP("PSARDCRS1",$J,I)
. K ^TMP("PSARDCRS1",$J,I)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSARDCRS 8429 printed Sep 23, 2025@19:26:29 Page 2
PSARDCRS ;BIRM/JMC - Return Drug Credit Report - Summary ;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 NEW PSARDST,PSAOUT,PRINTFLG
+5 KILL PAG,^TMP("PSARDCRS",$JOB),^TMP("PSARDCRS1",$JOB)
+6 SET PSAOUT=0
IF $GET(PSAEXCEL)=1
SET FIRSTHD=1
+7 DO STATUS
IF '$DATA(PSABASTS)
GOTO EXIT
+8 SET PSARDST=""
FOR
SET PSARDST=$ORDER(PSABASTS(PSARDST))
if PSARDST=""
QUIT
Begin DoDot:1
+9 SET PSAPHLC1=$PIECE($GET(PSAPHLOC),"^",2)
+10 USE IO
+11 IF $GET(PSAEXCEL)=0
Begin DoDot:2
+12 DO HDR
if PSAOUT
QUIT
+13 DO GETDATA
+14 if '$GET(PRINTFLG)
WRITE !!,"*** NO BATCHES FOUND ***",!!!
SET PRINTFLG=0
End DoDot:2
+15 IF $GET(PSAEXCEL)=1
DO GETDATA
if PSAOUT
QUIT
End DoDot:1
if PSAOUT
QUIT
+16 DO EXIT
+17 QUIT
HDR ; - Prints the Header
+1 NEW X,SS,DIR,JJ
+2 SET PAG=$GET(PAG)+1
+3 ;I PAG>1,'$G(PRINTFLG) D
+4 ;. W !!,"*** NO BATCHES FOUND ***",!!!
+5 IF PAG>1
IF $EXTRACT(IOST)="C"
Begin DoDot:1
+6 SET SS=22-$Y
FOR JJ=1:1:SS
WRITE !
+7 NEW DIR
SET DIR(0)="E"
SET DIR("A")=" Press ENTER to Continue or ^ to Exit"
+8 DO ^DIR
+9 SET PSAOUT=$SELECT($DATA(DIRUT):1,Y:0,1:1)
End DoDot:1
IF PSAOUT
QUIT
+10 WRITE @IOF,"Return Drug Credit Report (SUMMARY)",?71,"Page: ",$JUSTIFY(PAG,3)
+11 WRITE !,"PHARM LOCATION: ",$EXTRACT($PIECE(PSAPHLOC,"^",2),1,31),?$SELECT(PSARDST="AP":57,1:63),"STATUS: ",$GET(PSABASTS(PSARDST))
+12 WRITE !,"Date Range: "_$$FMTE^XLFDT(PSARDRBD,"2Z")_" THRU "_$$FMTE^XLFDT(PSARDRED,"2Z")
+13 WRITE ?53,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),"2Z")
+14 SET X=""
SET $PIECE(X,"-",80)="-"
WRITE !,X
+15 WRITE !,?39,$JUSTIFY("ORD",6),?46,"ORDER",?54,$JUSTIFY("DISP",6),?61,"DISP",?68,"UPD"
+16 IF PSARDST="PU"!(PSARDST="CO")
WRITE ?73,"ACTUAL"
+17 WRITE !,"DRUG (NDC)",?39,$JUSTIFY("QTY",6),?46,"UNIT",?54,$JUSTIFY("QTY",6),?61,"UNIT",?68,"INV"
+18 IF PSARDST="PU"!(PSARDST="CO")
WRITE ?73,"CREDIT$"
+19 WRITE !,X
+20 SET PRINTFLG=0
+21 QUIT
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
EXIT ; KILL VARIABLES AND EXIT
+1 DO ^%ZISC
+2 KILL PSABASTS,CREDTOT,CREDTOT1,DRUGTOT,DRUGTOT1,CRDTOTCO,PSARDST,PSABATCH,PSAPHLOC,EXPDAT,XX,Y,X,TMPBAT,TMPBAT1,TOT
+3 KILL BATTOT,PSARDRBD,PSARDRED,PSARDCMF,CRED,I,DIR,X,PAG,PSADTRNG,PSARDRTP,PSAPHLC1
+4 KILL PSABTCH,PSASCRL,CRDTOTC1,DIRUT,^TMP("PSARDCRS1",$JOB),^TMP("PSARDCRS",$JOB),FIRST,FIRSTHD,PSAEXCEL
+5 QUIT
GETDATA ; Retrieve data for printing
+1 NEW PSABATCH
SET PSABATCH=0
SET PSAPHLC1=$PIECE(PSAPHLOC,"^")
SET (BATTOT,CREDTOT1,DRUGTOT1,CRDTOTC1)=0
+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 PSARDCMF=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,4)
+10 SET BATTOT=BATTOT+1
+11 DO ITEMS
IF PSAOUT
QUIT
+12 ;I '$G(PSAEXCEL),$D(^TMP("PSARDCRS1",$J)) D PRINT S PRINTFLG=1 Q:PSAOUT
+13 IF '$GET(PSAEXCEL)
DO PRINT
SET PRINTFLG=1
if PSAOUT
QUIT
+14 IF $GET(PSAEXCEL)=1
IF $DATA(^TMP("PSARDCRS1",$JOB))
DO PRINT2
if PSAOUT
QUIT
+15 IF PSARDST="PU"
SET DRUGTOT1=DRUGTOT1+DRUGTOT
SET CREDTOT1=CREDTOT1+CREDTOT
+16 IF PSARDST="CO"
SET CRDTOTC1=CRDTOTC1+CRDTOTCO
End DoDot:1
if PSAOUT
QUIT
+17 if PSAOUT
QUIT
+18 if $GET(PSAEXCEL)=1
QUIT
+19 IF PSARDST="PU"
IF DRUGTOT1>0
WRITE !,"TOTALS: "_$GET(BATTOT)_" Batch"_$SELECT($GET(BATTOT)>1:"es",1:"")_", "_$GET(DRUGTOT1)_" Drug"_$SELECT($GET(DRUGTOT1)>1:"s",1:"")
+20 IF (PSARDST="PU"&($GET(CREDTOT1)>0))!(PSARDST="CO"&(($GET(CRDTOTC1))>0))
WRITE !,"CREDIT TOTAL: $"_$SELECT(PSARDST="CO":$JUSTIFY($GET(CRDTOTC1),0,2),PSARDST="PU":$JUSTIFY($GET(CREDTOT1),0,2),1:"")
+21 QUIT
+22 ;
ITEMS ; Retrieve individual drug entries that match the criteria for the report.
+1 IF $GET(PSAPHLC1)=""!($GET(PSABATCH)="")
QUIT
+2 NEW DRUGNAM
SET (DRUGNAM,I)=""
SET (I,DRUGTOT)=0
+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("PSARDCRS",$JOB,DRUGNAM,I)=""
End DoDot:1
+6 SET DRUGNAM=""
SET (SEQ,ITEM,CREDTOT,CRDTOTCO)=0
+7 FOR
SET DRUGNAM=$ORDER(^TMP("PSARDCRS",$JOB,DRUGNAM))
if DRUGNAM=""
QUIT
Begin DoDot:1
+8 FOR
SET ITEM=$ORDER(^TMP("PSARDCRS",$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 KILL DATA
MERGE DATA=FLDS(58.3511,ITEM_","_PSABATCH_","_PSAPHLC1_",")
+12 SET DRUG=$EXTRACT(DATA(.01,"E"),1,20)
SET NDC=DATA(3,"E")
SET QTY=DATA(6,"E")
+13 SET DISPUNT=$EXTRACT(DATA(8,"E"),1,6)
+14 SET ORDUNT=DATA(5,"I")
IF ORDUNT
SET ORDUNT=$EXTRACT($$GET1^DIQ(51.5,ORDUNT,.02,"E"),1,6)
+15 SET UPDINV=DATA(14,"E")
IF UPDINV=""
SET UPDINV="NO"
+16 SET RTRNQTY=DATA(17,"E")
+17 SET CRED=$TRANSLATE($SELECT(DATA(10,"E")="ACTUAL":DATA(12,"I"),PSARDST="CO":DATA(12,"I"),PSARDST="PU":DATA(11,"I"),1:""),",")
+18 SET $EXTRACT(LINE,1)=DRUG_" ("_NDC_")"
+19 SET $EXTRACT(LINE,39)=$JUSTIFY(QTY,7)
SET $EXTRACT(LINE,47)=ORDUNT
SET $EXTRACT(LINE,54)=$JUSTIFY(RTRNQTY,7)
SET $EXTRACT(LINE,62)=DISPUNT
+20 SET $EXTRACT(LINE,69)=UPDINV
SET $EXTRACT(LINE,73)=$SELECT(PSARDST'="PU"&(PSARDST'="CO"):"",1:$JUSTIFY($JUSTIFY(+CRED,0,2),8))
+21 IF $GET(PSAEXCEL)=0
SET LINE1(SEQ)=LINE
+22 IF $GET(PSAEXCEL)=1
Begin DoDot:3
+23 IF PSARDST'="CA"
SET EXPDAT=$$FMTE^XLFDT($PIECE($$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,$SELECT(PSARDST="PU":2,PSARDST="CO":9,1:3),"I"),"."),"2Z")
+24 IF PSARDST="CA"
SET EXPDAT=$$FMTE^XLFDT($PIECE($PIECE($GET(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^"),"."),"2Z")
+25 SET TMPBAT=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,.01)
+26 SET LINE1(SEQ)=$PIECE(PSAPHLOC,"^",2)_"^"_TMPBAT_"^"_PSABASTS(PSARDST)_"^"_EXPDAT_"^"_PSARDCMF_"^"_DRUG_"^"_NDC_"^"_QTY_"^"_ORDUNT_"^"_RTRNQTY_"^"_DISPUNT_"^"_UPDINV_"^"_$JUSTIFY(+CRED,0,2)
+27 IF PSARDST="CA"
SET LINE1(SEQ)=LINE1(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
+28 IF PSARDST="CO"
SET CRDTOTCO=CRDTOTCO+$GET(CRED)
+29 IF PSARDST="PU"
SET CREDTOT=CREDTOT+$GET(CRED)
SET DRUGTOT=DRUGTOT+1
+30 KILL LINE
+31 MERGE ^TMP("PSARDCRS1",$JOB)=LINE1
+32 SET ^TMP("PSARDCRS1",$JOB,"A")=SEQ
End DoDot:2
End DoDot:1
+33 KILL LINE,DATA,FLDS,^TMP("PSARDCRS",$JOB),LINE1,SEQ,DRUGNAM,ITEM,DRUG,NDC,QTY,DISPUNT,EXPDAT,ORDUNT,UPDINV,TMPBAT,RTRNQTY
+34 QUIT
PRINT ; Print the individual drug entries that match the criteria for the report.
+1 if PSAOUT
QUIT
+2 NEW I,FIRST
+3 SET TMPBAT1=""
SET (I,PSASCRL)=0
SET FIRST=1
SET TMPBAT=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,.01)
SET TOT=$GET(^TMP("PSARDCRS1",$JOB,"A"))
+4 IF PSARDST'="CA"
SET EXPDAT=$$FMTE^XLFDT($PIECE($$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,$SELECT(PSARDST="PU":2,PSARDST="CO":9,1:3),"I"),"."),"2Z")
+5 IF PSARDST="CA"
SET EXPDAT=$$FMTE^XLFDT($PIECE($PIECE($GET(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^"),"."),"2Z")
+6 IF $Y>(IOSL-6)
DO HDR
if PSAOUT
QUIT
+7 ;,PRTFTR()
if '$DATA(^TMP("PSARDCRS1",$JOB))
DO PRTLINE("")
+8 FOR
SET I=$ORDER(^TMP("PSARDCRS1",$JOB,I))
if I=""
QUIT
Begin DoDot:1
+9 IF $Y>(IOSL-6)
DO HDR
if PSAOUT
QUIT
IF I<TOT!(I=TOT)
SET TMPBAT1=TMPBAT_" (Contd.)"
SET PSASCRL=1
+10 DO PRTLINE(^TMP("PSARDCRS1",$JOB,I))
+11 KILL ^TMP("PSARDCRS1",$JOB,I)
End DoDot:1
if PSAOUT
QUIT
+12 ;W !
+13 if PSAOUT
QUIT
+14 DO PRTFTR()
+15 KILL TMPBAT,TMPBAT1,TOT
+16 QUIT
+17 ;
PRTFTR() ; Print Footer
+1 IF PSARDST="CO"!(PSARDST="PU")
Begin DoDot:1
+2 WRITE !?72,"========"
+3 WRITE !?25,"NUMBER OF ITEMS: ",+$GET(TOT),?56,"BATCH TOTAL: "
+4 WRITE ?72,$JUSTIFY($SELECT(PSARDST="CO":"$"_$JUSTIFY($GET(CRDTOTCO),0,2),1:"$"_$JUSTIFY($GET(CREDTOT),0,2)),8)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 WRITE !?25,"NUMBER OF ITEMS: ",+$GET(TOT)
End DoDot:1
+7 WRITE !
+8 QUIT
+9 ;
PRTLINE(LINE) ; Prints an Item line
+1 IF 'FIRST
IF PSASCRL
Begin DoDot:1
+2 WRITE !,"Batch #: "_TMPBAT1
+3 WRITE " "_$SELECT(PSARDST="CA":"Date Cancelled: ",PSARDST="PU":"Date Picked Up: ",PSARDST="CO":"Date Completed: ",1:"Date Entered: ")_EXPDAT
+4 WRITE " - "_$EXTRACT(PSARDCMF,1,22)
+5 KILL TMPBAT1
+6 SET PSASCRL=0
End DoDot:1
+7 IF FIRST
Begin DoDot:1
+8 WRITE !,"Batch #: "_TMPBAT
SET (PSASCRL,FIRST)=0
+9 WRITE " "_$SELECT(PSARDST="CA":"Date Cancelled: ",PSARDST="PU":"Date Picked Up: ",PSARDST="CO":"Date Completed: ",1:"Date Entered: ")_EXPDAT
+10 WRITE " - "_$EXTRACT(PSARDCMF,1,29)
+11 IF PSARDST="CA"
WRITE !,"Cancelled By: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE($GET(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",2),0)),"^"),1,18)_" "_"Cancelled Comments: "_$EXTRACT($PIECE($GET(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",3),1
,25)
End DoDot:1
+12 IF I'="A"
IF LINE'=""
WRITE !,LINE
+13 QUIT
PRINT2 ; Spreadsheet format
+1 NEW I
+2 SET I=""
+3 IF $GET(FIRSTHD)=1
Begin DoDot:1
+4 WRITE "PHARM LOC^BATCH #^BATCH STATUS^DATE COMPLETED/CANCELLED/PICKED UP"
+5 WRITE "^RETURN CONTRACTOR^DRUG^NDC^ORD QTY^ORDER UNIT^DISP QTY^DISP UNIT^UPDATE INVENTORY^ACTUAL CREDIT^CANCELLED BY^CANCELLED CMTS"
End DoDot:1
SET FIRSTHD=0
+6 FOR
SET I=$ORDER(^TMP("PSARDCRS1",$JOB,I))
if I=""
QUIT
Begin DoDot:1
+7 IF I'="A"
WRITE !,^TMP("PSARDCRS1",$JOB,I)
+8 KILL ^TMP("PSARDCRS1",$JOB,I)
End DoDot:1
if PSAOUT
QUIT
+9 QUIT
