| [613] | 1 | PSAVERA ;BHM/DBM - Change verified invoice data;16AUG05
|
|---|
| 2 | ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,36,40,53,63**; 10/24/97;Build 10
|
|---|
| 3 | ;
|
|---|
| 4 | ;References to ^DIC(51.5 are covered by IA #1931
|
|---|
| 5 | ;References to ^PSDRUG( are covered by IA #2095
|
|---|
| 6 | D Q
|
|---|
| 7 | D HOME^%ZIS S XX="VERIFIED INVOICE ALTERATION SCREEN" W @IOF,!!,?((IOM/2)-($L(XX)/2)),XX,!!
|
|---|
| 8 | ORDR ;Get Order Number
|
|---|
| 9 | S DIC(0)="AEQMZ",DIC("A")="Select Order Number: ",DIC="^PSD(58.811," D ^DIC K DIC G Q:+Y'>0 S PSAIEN=+Y,PSAORD=$P(Y,U,2)
|
|---|
| 10 | ;
|
|---|
| 11 | INV ;Get Invoice Number
|
|---|
| 12 | S DIC(0)="AEQMZ",DIC("A")="Select Invoice Number: ",DIC="^PSD(58.811,"_PSAIEN_",1,",D="ASTAT" D ^DIC K DIC G Q:+Y'>0 S PSAIEN1=+Y,PSAINV=$P(Y,U,2)
|
|---|
| 13 | S DATA=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,0))
|
|---|
| 14 | S PSALOC=$S($P(DATA,"^",12)'="":$P(DATA,"^",12),1:$P(DATA,"^",5)) I $G(PSALOC)="" S PSALOC="No Location identified"
|
|---|
| 15 | D ^PSAVERA1
|
|---|
| 16 | K DATA,PSAITM,LINENUM,X,X1,X2,X3,DIC,DA,DR D HDR
|
|---|
| 17 | DISP S PSAITM=$S('$D(PSAITM):$O(INVARRAY(PSAORD,PSAINV,0)),1:$O(INVARRAY(PSAORD,PSAINV,PSAITM))) G LINEASK:PSAITM'>0 S LINENUM=$G(LINENUM)+1
|
|---|
| 18 | S DATA=$G(INVARRAY(PSAORD,PSAINV,PSAITM)),PSAOU=$P(DATA,"^",4) I $G(PSAOU) S PSAOU(1)=$P($G(^DIC(51.5,$P(DATA,"^",4),0)),"^") ;Current Order Unit ;; <*63 RJS
|
|---|
| 19 | W !,PSAITM,?10,$S($P($P(DATA,"^",1),"~",1)'>0:$P($P(DATA,"^",1),"~",1),1:$P($P(DATA,"^",1),"~",2)),?45,$S($G(PSAOU)="":"none",$G(PSAOU(1))'="":$G(PSAOU(1)),1:$G(PSAAOU)),?55,$J($P($G(DATA),"^",2),4),?61,$P(DATA,"^",5) ;; *63 RJS>
|
|---|
| 20 | I IOST["C-",$Y>(IOSL-5) S DIR(0)="E" D ^DIR G Q:$G(DUOUT)=1 D HDR
|
|---|
| 21 | G DISP
|
|---|
| 22 | LINEASK ;ask for line number
|
|---|
| 23 | W !,"Enter the corresponding item number to edit: " R AN:DTIME I AN["^"!(AN="") G Q
|
|---|
| 24 | I AN<1!(AN>LINENUM) W !,"Enter a number between 1 & ",LINENUM,! G LINEASK
|
|---|
| 25 | I "?"[AN W !,"Select the number that corresponds to the line item that needs editing",! K AN G LINEASK
|
|---|
| 26 | S DATA=$G(INVARRAY(PSAORD,PSAINV,AN))
|
|---|
| 27 | S PSALINE=AN,PSAIN="NADA" I '$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)) W !,"Invalid line selection." G LINEASK
|
|---|
| 28 | S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),PSASUP=0
|
|---|
| 29 | S PSACS=0 S:+$P(PSADATA,"^",10) PSACS=$G(PSACS)+1
|
|---|
| 30 | S PSANDC=$P(PSADATA,"^",11)
|
|---|
| 31 | S PSALINEN="" D VERDISP^PSAUTL4 W !,PSASLN,!
|
|---|
| 32 | S PSAVEND=$P(^PSD(58.811,PSAIEN,0),"^",2)
|
|---|
| 33 | S PSAODUOU=PSADUOU
|
|---|
| 34 | ;; *63
|
|---|
| 35 | S PSA581="" F S PSA581=$O(^PSD(58.81,"PV",PSAINV,PSA581)) Q:'PSA581 I $P(^PSD(58.81,PSA581,0),U,5)=PSADRG S PSABFR(581)=$G(^PSD(58.81,PSA581,0))
|
|---|
| 36 | S:$G(PSABFR(581)) PSDTRN=$P(PSABFR(581),U,1),PSABFR("Q")=$S($G(^PSD(58.81,PSDTRN,4)):$P(^PSD(58.81,PSDTRN,4),"^",3),1:$P(^PSD(58.81,PSDTRN,0),"^",6)) ; <*63 RJS >
|
|---|
| 37 | DRG W !,"Select (D)rug or (O)rder Unit " R AN:DTIME G Q:AN["^"!(AN="") W $S("Dd"[AN:"rug","oO"[AN:"rder Unit",1:"??") I "DdOo"'[AN W !,"Enter a 'D' to edit the Drug, or 'O' to edit the order unit",! K AN G DRG
|
|---|
| 38 | I "Dd"'[AN D ^PSAVERA3 G Q ;;*63
|
|---|
| 39 | ;Get either new name of drug or supply item description
|
|---|
| 40 | S PSABFR=$P(DATA,"~",1),PSABFR(1)=$S(PSABFR'?.N:PSABFR,1:$P($P(DATA,"^"),"~",2)),PSABFR("NDC")=$P(PSADATA,"^",11) ;;*63
|
|---|
| 41 | DRGAGN D
|
|---|
| 42 | .S X1=0 F S X1=$O(^PSDRUG(PSABFR,1,X1)) Q:X1'>0 S DATA=$G(^PSDRUG(PSABFR,1,X1,0)) I $P(DATA,"^",2)=PSABFR("NDC") S PSABFR("SYNNODE")=X1 ;;*63
|
|---|
| 43 | D PSANDC1^PSAHELP S PSADASH=PSANDCX K PSANDCX
|
|---|
| 44 | I $G(PSABFR("SYNNODE"))="",$E(PSABFR("NDC"))'="S" S PSABFR("NDC")="S"_PSABFR("NDC") G DRGAGN ;may be supply, try again
|
|---|
| 45 | I $G(PSABFR("SYNNODE"))'="" S PSASUB=PSABFR("SYNNODE") D
|
|---|
| 46 | .S DATA=$G(^PSDRUG(PSABFR,1,PSASUB,0)),PSAOU=$P(DATA,"^",5),PSAPOU=$P(DATA,"^",6),PSADUOU=$P(DATA,"^",7),PSAPDUOU=$P(DATA,"^",8)
|
|---|
| 47 | .S PSADU=$P($G(^PSDRUG(PSABFR,660)),"^",8)
|
|---|
| 48 | I ($G(PSAOU)=""!$G(PSAPOU)=""!$G(PSADUOU)=""!$G(PSAPDUOU)="") W !!,"Sorry, I could not find the necessary information to change the drug selection.",! G Q
|
|---|
| 49 | W !,"Current Drug : ",PSABFR(1)
|
|---|
| 50 | DRG1 S PSAGAIN=0,DIC("A")="Select name of Correct Drug: ",PSABFR=PSADRG,DIC(0)="AEQMZ",DIC="^PSDRUG(" D ^DIC K DIC G Q:PSAOUT
|
|---|
| 51 | I $G(DTOUT)!($G(DUOT))!(Y<0) S PSAOUT=1 Q
|
|---|
| 52 | S (PSADJ,PSADRG)=+Y
|
|---|
| 53 | W !!,"Comparing drug file data..."
|
|---|
| 54 | S PSAODU=$P($G(^PSDRUG(PSADRG,660)),"^",8),PSAXDUOU=$P($G(^PSDRUG(PSADRG,660)),"^",5)
|
|---|
| 55 | I $P($G(^PSDRUG(PSADRG,660)),"^",2)'=$G(PSAOU) W !,"The Order Units are different between these two drugs."
|
|---|
| 56 | I $P($G(^PSDRUG(PSADRG,660)),"^",8)'=$G(PSADU) W !,"Please Enter an appropriate Dispense Unit" S DIE="^PSDRUG(",DA=PSADRG,DR="14.5" D ^DIE S PSADU=$P(^PSDRUG(PSADRG,660),"^",8)
|
|---|
| 57 | I $P($G(^PSDRUG(PSADRG,660)),"^",5)'=$G(PSADUOU) W !,"Please enter the appropriate Dispense Units per order unit" S DIE="^PSDRUG(",DA=PSADRG,DR="15" D ^DIE S PSADUOU=$P(^PSDRUG(PSADRG,660),"^",5)
|
|---|
| 58 | K DIE,DA,DR
|
|---|
| 59 | ASK R !!,"Are you sure about this ? NO// ",AN:DTIME G NOCHNG:AN["^"!(AN="")
|
|---|
| 60 | S AN=$E(AN) I "yYnN"'[AN W !,"Answer yes, and the data on file for the current drug will be transferred",!,"to the new drug selection.",!,"That includes Order Unit, Dispense Unit, Dispense Units per Order Unit, etc.",!! G ASK
|
|---|
| 61 | I "Nn"[AN G NOCHNG ;*53
|
|---|
| 62 | S PSAAFTER=PSADRG,PSADRG=PSABFR
|
|---|
| 63 | I $D(^PSDRUG(PSADRG))&$G(PSABFR(581)) D
|
|---|
| 64 | .W !,"Removing "_PSABFR("Q")_" from "_PSABFR(1)
|
|---|
| 65 | .S FMDATA=$P($G(^PSDRUG(PSADRG,660.1)),"^")-PSABFR("Q"),DIE="^PSDRUG(",DA=PSADRG,DR="50////^S X="_FMDATA
|
|---|
| 66 | .F L +^PSDRUG(DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|---|
| 67 | .D ^DIE L -^PSDRUG(DA,0) K FMDATA
|
|---|
| 68 | S PSADRG=PSAAFTER
|
|---|
| 69 | I $G(PSAPOU)="",$G(PSAPRICE)'="" S PSAPOU=PSAPRICE
|
|---|
| 70 | W !,"Adding "_($G(PSAQTY)*$G(PSADUOU))_" to "_$P($G(^PSDRUG(PSADRG,0)),"^")
|
|---|
| 71 | W !,"Entering new drug selection as an adjustment."
|
|---|
| 72 | S PSAREA="",PSADJFLD="D",PSADJ=PSADRG D RECORD^PSAVER2,50^PSAVER7
|
|---|
| 73 | FILE ;File dispense units per order units into 58.811
|
|---|
| 74 | S DIE="^PSD(58.811,"_PSAIEN_",1,"_PSAIEN1_",1,",DA=PSALINE,DA(1)=PSAIEN1,DA(2)=PSAIEN,DR="10///"_PSADUOU D ^DIE
|
|---|
| 75 | G:$D(^PSD(58.811,"ASTAT","P",PSAIEN,PSAIEN1)) Q ;; *63 RJS
|
|---|
| 76 | D UPDATE^PSAVERA1 G Q
|
|---|
| 77 | ;
|
|---|
| 78 | HDR W @IOF,!?25,"EDIT VERIFIED INVOICED ITEM SCREEN",!,PSASLN,!
|
|---|
| 79 | W !,?44,"Order",!,"#",?10,"Drug/Item Name",?45,"Unit",?56,"Qnty.",?67,"NDC",!,PSASLN,! Q
|
|---|
| 80 | Q K AN,D,DA,DATA,DIC,DIR,INVARRAY,LINENUM,POP,PSA50IEN,PSA581,PSAABAL,PSAAFTER,PSAAQTY,PSABAL,PSABFR,PSACS,PSADASH,PSADATA,PSADJ,PSADJD,PSADJFLD,PSADJO,PSADJP,PSADJQ,PSADRG,PSADRUGN,PSADT
|
|---|
| 81 | K PSADU,PSADUOU,PSADUREC,PSAEDTT,PSAGAIN,PSAIEN,PSAIEN1,PSAIN,PSAINV,PSAITM,PSALINE,PSALINEN,PSALOC,PSANDC,PSANDUOU,PSANEW,PSANODE,PSANPDU,PSANQTY,PSAODASH,PSAODU,PSAODUOU,PSAONDC,PSAORD
|
|---|
| 82 | K PSAOU,PSAOUT,PSAPOU,PSAPRICE,PSAQTY,PSAREA,PSAREORD,PSASET,PSASLN,PSASTOCK,PSASUB,PSASUP,PSASUPP,PSAT,PSATEMP,PSAUPC,PSAVDUZ,PSAVEND,PSAVER,PSAVSN,PSAXDUOU,PSDTRN,X,X1,X2,X3,XX,XXX,Y
|
|---|
| 83 | Q
|
|---|
| 84 | NOCHNG ;*53 said no to changes, backout the edits on the new drug choice.
|
|---|
| 85 | K DIE,DR,DA
|
|---|
| 86 | S DIE="^PSDRUG(",DA=PSADRG,DR="14.5////^S X=PSAODU;15////^S X=PSAXDUOU" D ^DIE
|
|---|
| 87 | W !,"NO CHANGE",! G Q
|
|---|
