Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSARDCRD

PSARDCRD.m

Go to the documentation of this file.
  1. PSARDCRD ;BIRM/JMC - Return Drug Credit Report - Detailed ;06/04/08
  1. ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**69**;10/24/97;Build 9
  1. ;References to ORDER UNIT file (#51.5) supported by IA #1931
  1. ;
  1. ;
  1. N PSARDST,PSAOUT,PRINTFLG
  1. S PSAOUT=0
  1. K PAG,^TMP("PSARDCRD1",$J),^TMP("PSARDCRD",$J)
  1. D STATUS I '$D(PSABASTS) G EXIT
  1. I $G(PSAEXCEL)=1 S FIRSTHD=1
  1. S PSARDST="" F S PSARDST=$O(PSABASTS(PSARDST)) Q:PSARDST="" D Q:PSAOUT
  1. . S PSAPHLC1=$P($G(PSAPHLOC),"^",2)
  1. . S (PRINTFLG,PSAOUT)=0,(PSABTCH,PSARDCMF)=""
  1. . U IO D GETDATA Q:PSAOUT
  1. . I '$G(PSAEXCEL),'$G(PRINTFLG) D
  1. . . D HDR W:'$G(PRINTFLG) !!,"*** NO BATCHES FOUND ***",!!! S PRINTFLG=0
  1. D EXIT
  1. Q
  1. ;
  1. HDR ; - Prints the Header
  1. N X,DIR,SS,JJ
  1. S PAG=$G(PAG)+1
  1. I PAG>1,$E(IOST)="C" D Q:PSAOUT
  1. . S SS=22-$Y F JJ=1:1:SS W !
  1. . S DIR(0)="E",DIR("A")=" Press ENTER to Continue or ^ to Exit" D ^DIR
  1. . S PSAOUT=$S($D(DIRUT):1,Y:0,1:1)
  1. W @IOF,"Return Drug Credit Report (DETAILED)",?71,"Page: ",$J(PAG,3)
  1. W !,"PHARM LOCATION: ",$E($P(PSAPHLOC,"^",2),1,40),?63,"BATCH #: "_$G(PSABTCH)
  1. W !,"RTN CONTRACTOR: ",$E($G(PSARDCMF),1,31),?$S(PSARDST="AP":57,1:63),"STATUS: ",$G(PSABASTS(PSARDST))
  1. I PSARDST="CA",$G(PSABATCH) D
  1. . W !,"CANCELLED CMTS: ",$E($P($G(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",3),1,31)
  1. . W ?48,$J("CANCELLED BY: "_$E($P($G(^VA(200,+$P($G(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^",2),0)),"^"),1,18),32)
  1. W !,"Date Range: "_$$FMTE^XLFDT(PSARDRBD,"2Z")_" THRU "_$$FMTE^XLFDT(PSARDRED,"2Z")
  1. W ?53,"Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),"2Z")
  1. I PSARDST="PU"!(PSARDST="CO") W !,"Total Batch Credit: $"_$J($S(PSARDST="PU":$G(CREDTOT),PSARDST="CO":$G(CRDTOTCO),1:0),0,2)
  1. S X="",$P(X,"-",80)="-" W !,X
  1. Q
  1. ;
  1. STATUS ;Create local array of statuses.
  1. F I=1:1:$L(PSABASTS,",") D
  1. . S PSARDST=$P(PSABASTS,",",I)
  1. . S PSABASTS(PSARDST)=$S(PSARDST="AP":"AWAITING PICKUP",PSARDST="PU":"PICKED UP",PSARDST="CA":"CANCELLED",1:"COMPLETED")
  1. Q
  1. ;
  1. EXIT ; KILL VARIABLES AND EXIT
  1. D ^%ZISC
  1. K PSABASTS,CREDTOT,CREDTOT1,DRUGTOT,DRUGTOT1,CRDTOTCO,PSARDST,PSABATCH,PSAPHLOC
  1. K BATTOT,PSARDRBD,PSARDRED,PSARDCMF,CRED,I,DIR,X,PAG,PSADTRNG,PSARDRTP,PSAPHLC1
  1. K PSABTCH,J,XX,MFR,UPC,UPDINV,CREATEBY,CREATEON,CREDSTAT,RTRNRSN,CRED1,X1,X2,X3
  1. K DIRUT,^TMP("PSARDCRD1",$J),^TMP("PSARDCRD",$J),FIRSTHD,PSAEXCEL
  1. Q
  1. ;
  1. GETDATA ; Retrieve data for printing
  1. N PSABATCH S PSABATCH="",PSAPHLC1=$P(PSAPHLOC,"^")
  1. F S PSABATCH=$O(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH)) Q:PSABATCH="" D Q:PSAOUT
  1. . Q:'$D(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH))
  1. . I $$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,1,"I")'=PSARDST Q
  1. . 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
  1. . 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
  1. . I PSARDST="CA",$P($P(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN"),"^"),".")<PSARDRBD Q
  1. . I PSARDST="CA",$P($P(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN"),"^"),".")>PSARDRED Q
  1. . S PSABTCH=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,.01)
  1. . S PSARDCMF=$$GET1^DIQ(58.351,PSABATCH_","_PSAPHLC1,4)
  1. . D ITEMS Q:PSAOUT
  1. . I $G(PSAEXCEL)=0,$D(^TMP("PSARDCRD1",$J)) D HDR Q:PSAOUT D PRINT
  1. . I $G(PSAEXCEL)=1,$D(^TMP("PSARDCRD1",$J)) D HDR2,PRINT2 Q:PSAOUT
  1. Q
  1. ;
  1. ITEMS ; Retrieve individual drug entries that match the criteria for the report.
  1. I $G(PSAPHLC1)=""!($G(PSABATCH)="") Q
  1. N I,J,DRUGNAM,X,XX S (DRUGNAM,I,J,X,XX)="",$P(X," ",80)=" ",$P(XX,"-",80)="-"
  1. F S I=$O(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"ITM",I)) Q:I="" D
  1. . S DRUGNAM=$$GET1^DIQ(58.3511,I_","_PSABATCH_","_PSAPHLC1,.01) I DRUGNAM="" Q
  1. . S ^TMP("PSARDCRD",$J,DRUGNAM,I)=""
  1. S DRUGNAM="",(SEQ,ITEM,CREDTOT,CRDTOTCO)=0
  1. F S DRUGNAM=$O(^TMP("PSARDCRD",$J,DRUGNAM)) Q:DRUGNAM="" D
  1. . F S ITEM=$O(^TMP("PSARDCRD",$J,DRUGNAM,ITEM)) Q:ITEM="" D
  1. . . S SEQ=SEQ+1
  1. . . D GETS^DIQ(58.3511,ITEM_","_PSABATCH_","_PSAPHLC1_",","*","IE","FLDS")
  1. . . M DATA=FLDS(58.3511,ITEM_","_PSABATCH_","_PSAPHLC1_",")
  1. . . S DRUG=$E(DATA(.01,"E"),1,25),NDC=DATA(3,"E"),QTY=DATA(6,"E"),RTNQTY=DATA(17,"E")
  1. . . S MFR=DATA(2,"E"),EXPDAT=$$FMTE^XLFDT(DATA(9,"I"),"2Z")
  1. . . S ORDUNT=DATA(5,"I") I ORDUNT'="" S ORDUNT=$$GET1^DIQ(51.5,ORDUNT,.02,"I")
  1. . . S UPC=DATA(4,"E"),CREATEBY=$E(DATA(16,"E"),1,21),CREATEON=$$FMTE^XLFDT($P(DATA(1,"I"),"."),"2Z")
  1. . . S UPDINV=DATA(14,"E") I UPDINV="" S UPDINV="NO"
  1. . . S RTRNRSN=$E(DATA(15,"E"),1,21)
  1. . . S DISPUNT=$E(DATA(8,"E"),1,15)
  1. . . S CREDSTAT=DATA(10,"E") I CREDSTAT="" S CREDSTAT="**N/A**"
  1. . . S CRED=$TR($S(CREDSTAT="ACTUAL":DATA(12,"I"),PSARDST="CO":DATA(12,"I"),PSARDST="PU":DATA(11,"I"),1:""),",")
  1. . . I $G(PSAEXCEL)=0 D
  1. . . . S $E(LINE1,1)=$J("Drug: ",15)_DRUG,$E(LINE1,45)=$J("Credit Status: ",15)_CREDSTAT
  1. . . . 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:"")
  1. . . . S $E(LINE3,1)=$J("NDC: ",15)_NDC,$E(LINE3,45)=$J("Exp. Date: ",15)_EXPDAT
  1. . . . S $E(LINE4,1)=$J("Rtrn Ord Qty: ",15)_QTY_" "_ORDUNT,$E(LINE4,45)=$J("Created By: ",15)_CREATEBY
  1. . . . S $E(LINE5,1)=$J("Rtrn Disp Qty: ",15)_RTNQTY_" "_DISPUNT,$E(LINE5,45)=$J("Created On: ",15)_CREATEON
  1. . . . S $E(LINE6,1)=$J("UPC: ",15)_UPC,$E(LINE6,45)=$J("Upd Inventory: ",15)_UPDINV
  1. . . . S $E(LINE7,1)=$J("Return Rsn: ",15)_RTRNRSN
  1. . . . S $E(LINE8,1)=XX
  1. . . . S LINE(PSARDST,SEQ,1)=LINE1
  1. . . . S LINE(PSARDST,SEQ,2)=LINE2
  1. . . . S LINE(PSARDST,SEQ,3)=LINE3
  1. . . . S LINE(PSARDST,SEQ,4)=LINE4
  1. . . . S LINE(PSARDST,SEQ,5)=LINE5
  1. . . . S LINE(PSARDST,SEQ,6)=LINE6
  1. . . . S LINE(PSARDST,SEQ,7)=LINE7
  1. . . . S LINE(PSARDST,SEQ,8)=LINE8
  1. . . . I PSARDST="CO" S CRDTOTCO=CRDTOTCO+$G(CRED)
  1. . . . I PSARDST="PU" S CREDTOT=CREDTOT+$G(CRED)
  1. . . I $G(PSAEXCEL)=1 D
  1. . . . 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")
  1. . . . I PSARDST="CA" S EXPDAT1=$$FMTE^XLFDT($P($P($G(^PSD(58.35,PSAPHLC1,"BAT",PSABATCH,"CAN")),"^"),"."),"2Z")
  1. . . . S CREATEON=$$FMTE^XLFDT(DATA(1,"I"),"2ZP")
  1. . . . 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))_"^"
  1. . . . S LINE(SEQ)=LINE(SEQ)_MFR_"^"_UPC_"^"_RTRNRSN_"^"_CREDSTAT_"^"_$S(DATA(11,"I")="":"",1:$J(DATA(11,"I"),0,2))_"^"_EXPDAT_"^"_CREATEBY_"^"_CREATEON
  1. . . . 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)
  1. . . M ^TMP("PSARDCRD1",$J)=LINE
  1. . . K LINE,LINE1,LINE2,LINE3,LINE4,LINE5,LINE6,LINE7,LINE8,DATA
  1. K LINE,DATA,FLDS,^TMP("PSARDCRD",$J),LINE1,SEQ,DRUGNAM,ITEM,DRUG,NDC,QTY,DSPUNT,EXPDAT,ORDUNT,UPDINV,EXPDAT1,RTNQTY,DISPUNT
  1. Q
  1. ;
  1. PRINT ; Print the individual drug entries that match the criteria for the report.
  1. Q:PSAOUT
  1. N X1,X2,X3
  1. S X1="",(X2,X3)=0
  1. F S X1=$O(^TMP("PSARDCRD1",$J,X1)) Q:X1="" D Q:PSAOUT
  1. . F S X2=$O(^TMP("PSARDCRD1",$J,X1,X2)) Q:X2="" D Q:PSAOUT
  1. . . I $Y>(IOSL-9) D HDR Q:PSAOUT
  1. . . F S X3=$O(^TMP("PSARDCRD1",$J,X1,X2,X3)) Q:X3="" D Q:PSAOUT
  1. . . . W !,^TMP("PSARDCRD1",$J,X1,X2,X3)
  1. . . . K ^TMP("PSARDCRD1",$J,X1,X2,X3)
  1. S PRINTFLG=1
  1. W !
  1. Q
  1. HDR2 ;
  1. I $G(FIRSTHD)=1 D S FIRSTHD=0
  1. . W "PHARM LOC^BATCH #^BATCH STAT^DATE COMPLETED/CANCELLED/PICKED UP^RETURN CONTRACTOR^"
  1. . W "DRUG^NDC^RTRN ORD QTY^RTRN DISP QTY^UPD INVENTORY^ACTUAL CRED^DRUG MFR^DRUG UPC^RTRN RSN^"
  1. . W "CRED STAT^ESTD CRED^DRUG EXPIRE DATE^CREATED BY^CREATED ON^CANCELELD BY^CANCELLED CMTS"
  1. Q
  1. PRINT2 ; Spreadsheet format
  1. Q:PSAOUT
  1. N X1
  1. S X1=""
  1. F S X1=$O(^TMP("PSARDCRD1",$J,X1)) Q:X1="" D Q:PSAOUT
  1. . W !,^TMP("PSARDCRD1",$J,X1)
  1. . K ^TMP("PSARDCRD1",$J,X1)
  1. Q