- 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 Feb 18, 2025@23:16:47 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