Changeset 623 for WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAVERA.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAVERA.m
r613 r623 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 1 PSAVERA ;BHM/DBM - Change verified invoice data;16AUG05 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,36,40,53**; 10/24/97 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 ; 14 S DATA=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,0)) 15 S PSALOC=$S($P(DATA,"^",12)'="":$P(DATA,"^",12),1:$P(DATA,"^",5)) I $G(PSALOC)="" S PSALOC="No Location identified" 16 D ^PSAVERA1 17 ; 18 K DATA,PSAITM,LINENUM,X,X1,X2,X3,DIC,DA,DR D HDR 19 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 20 S DATA=$G(INVARRAY(PSAORD,PSAINV,PSAITM)) 21 S PSAOU=$P(DATA,"^",4) I $G(PSAOU) S PSAOU(1)=$P($G(^DIC(51.5,$P(DATA,"^",4),0)),"^") ;Current Order Unit 22 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) 23 I IOST["C-",$Y>(IOSL-5) S DIR(0)="E" D ^DIR G Q:$G(DUOUT)=1 D HDR 24 G DISP 25 LINEASK ;ask for line number 26 W !,"Enter the corresponding item number to edit: " R AN:DTIME I AN["^"!(AN="") G Q 27 I AN<1!(AN>LINENUM) W !,"Enter a number between 1 & ",LINENUM,! G LINEASK 28 I "?"[AN W !,"Select the number that corresponds to the line item that needs editing",! K AN G LINEASK 29 S DATA=$G(INVARRAY(PSAORD,PSAINV,AN)) 30 S PSALINE=AN,PSAIN="NADA" I '$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)) W !,"Invalid line selection." G LINEASK 31 S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),PSASUP=0 32 S PSACS=0 S:+$P(PSADATA,"^",10) PSACS=$G(PSACS)+1 33 S PSANDC=$P(PSADATA,"^",11) 34 S PSALINEN="" D VERDISP^PSAUTL4 W !,PSASLN,! 35 S PSAVEND=$P(^PSD(58.811,PSAIEN,0),"^",2) 36 ;VMP OIFO BAY PINES;VGF;PSA*3.0*40;GET ORIGINAL DISPENSE UNITS PER ORDER UNIT FOR SUBTRACTION 37 S PSAODUOU=PSADUOU 38 ; 39 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 40 I "Dd"'[AN G ^PSAVERA3 41 ;Get either new name of drug or supply item description 42 S PSABEFOR=$P(DATA,"~",1),PSABEFOR(1)=$S(PSABEFOR'?.N:PSABEFOR,1:$P($P(DATA,"^"),"~",2)) 43 S PSABEFOR("NDC")=$P(PSADATA,"^",11) 44 DRGAGN D 45 .S X1=0 F S X1=$O(^PSDRUG(PSABEFOR,1,X1)) Q:X1'>0 S DATA=$G(^PSDRUG(PSABEFOR,1,X1,0)) I $P(DATA,"^",2)=PSABEFOR("NDC") S PSABEFOR("SYNNODE")=X1 46 D PSANDC1^PSAHELP S PSADASH=PSANDCX K PSANDCX 47 I $G(PSABEFOR("SYNNODE"))="",$E(PSABEFOR("NDC"))'="S" S PSABEFOR("NDC")="S"_PSABEFOR("NDC") G DRGAGN ;may be supply, try again 48 I $G(PSABEFOR("SYNNODE"))'="" S PSASUB=PSABEFOR("SYNNODE") D 49 .S DATA=$G(^PSDRUG(PSABEFOR,1,PSASUB,0)),PSAOU=$P(DATA,"^",5),PSAPOU=$P(DATA,"^",6),PSADUOU=$P(DATA,"^",7),PSAPDUOU=$P(DATA,"^",8) 50 .S PSADU=$P($G(^PSDRUG(PSABEFOR,660)),"^",8) 51 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 52 W !,"Current Drug : ",PSABEFOR(1) 53 DRG1 S PSAGAIN=0,DIC("A")="Select name of Correct Drug: ",PSABEFOR=PSADRG,DIC(0)="AEQMZ",DIC="^PSDRUG(" D ^DIC K DIC G Q:PSAOUT 54 I $G(DTOUT)!($G(DUOT)) S PSAOUT=1 Q 55 S (PSADJ,PSADRG)=+Y 56 W !!,"Comparing drug file data..." 57 S PSAODU=$P($G(^PSDRUG(PSADRG,660)),"^",8),PSAXDUOU=$P($G(^PSDRUG(PSADRG,660)),"^",5) 58 I $P($G(^PSDRUG(PSADRG,660)),"^",2)'=$G(PSAOU) W !,"The Order Units are different between these two drugs." 59 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) 60 ;VMP OIFO BAY PINES;VGF;PSA*3.0*36 61 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) 62 K DIE,DA,DR 63 ASK R !!,"Are you sure about this ? NO// ",AN:DTIME G NOCHNG:AN["^"!(AN="") 64 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 65 I "Nn"[AN G NOCHNG ;*53 66 ;VMP OIFO BAY PINES;VGF;PSA*3.0*36 67 S PSAAFTER=PSADRG,PSADRG=PSABEFOR 68 I $D(^PSDRUG(PSADRG)) D 69 .;VMP OIFO BAY PINES;VGF;PSA*3.0*40 70 .W !,"Removing "_($G(PSAQTY)*$G(PSAODUOU))_" from "_PSABEFOR(1) 71 .S FMDATA=$P($G(^PSDRUG(PSADRG,660.1)),"^")-(PSAODUOU*PSAQTY) 72 .S DIE="^PSDRUG(",DA=PSADRG,DR="50////^S X="_FMDATA 73 .F L +^PSDRUG(DA,0):0 I Q 74 .D ^DIE 75 .L -^PSDRUG(DA,0) 76 .K FMDATA 77 S PSADRG=PSAAFTER 78 I $G(PSAPOU)="",$G(PSAPRICE)'="" S PSAPOU=PSAPRICE 79 W !,"Adding "_($G(PSAQTY)*$G(PSADUOU))_" to "_$P($G(^PSDRUG(PSADRG,0)),"^") 80 W !,"Entering new drug selection as an adjustment." 81 S PSAREA="",PSADJFLD="D",PSADJ=PSADRG D RECORD^PSAVER2 82 D 50^PSAVER7 83 FILE ;File dispense units per order units into 58.811 84 S DIE="^PSD(58.811,"_PSAIEN_",1,"_PSAIEN1_",1," 85 S DA=PSALINE,DA(1)=PSAIEN1,DA(2)=PSAIEN 86 S DR="10///"_PSADUOU 87 D ^DIE 88 ;File data in 58.8 89 ;PSALOC= Either PSALOC or PSALOCB 90 ;VMP OIFO BAY PINES;VGF;PSA*3.0*40;UPDATE 91 S PSADRG=PSABEFOR 92 F L +^PSD(58.8,PSALOC,1,PSADRG,0):0 I Q 93 S PSADUREC=PSAQTY*$G(PSAODUOU) 94 S PSABAL=$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",4) 95 S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",4)=PSABAL-PSADUREC 96 L -^PSD(58.8,PSALOC,1,PSADRG,0) 97 ;VMP OIFO BAY PINES;VGF;PSA*3.0*40;ADDED *$G(PSADUOU) 98 S PSADRG=PSAAFTER 99 S PSADUREC=PSAQTY*$G(PSADUOU) 100 D NOW^%DTC S PSADT=+$E(%,1,14) 101 I '$D(^PSD(58.8,PSALOC,1,PSADRG,0)) D 102 .S:'$D(^PSD(58.8,PSALOC,1,0)) DIC("P")=$P(^DD(58.8,10,0),"^",2) 103 .S DA(1)=PSALOC,DIC="^PSD(58.8,"_DA(1)_",1,",(DA,DINUM,X)=PSADRG,DIC(0)="L",DLAYGO=58.8 ;*53 104 .F L +^PSD(58.8,PSALOC,0):0 I Q 105 .D FILE^DICN L -^PSD(58.8,PSALOC,0) K DIC,DA,DLAYGO 106 F L +^PSD(58.8,PSALOC,1,PSADRG,0):0 I Q 107 S PSABAL=$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",4) 108 I $P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",1)'=PSADRG S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",1)=PSADRG 109 S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",4)=PSADUREC+PSABAL 110 I +$P($G(^PSD(58.8,PSALOC,0)),"^",14) D 111 .I PSASTOCK'=$P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",3) S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",3)=PSASTOCK 112 .I PSAREORD'=$P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",5) S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",5)=PSAREORD 113 S:'$D(^PSD(58.8,PSALOC,1,PSADRG,5,0)) DIC("P")=$P(^DD(58.8001,20,0),"^",2) 114 I '$D(^PSD(58.8,PSALOC,1,PSADRG,5,$E(DT,1,5)*100,0)) D 115 .S DIC="^PSD(58.8,"_PSALOC_",1,"_PSADRG_",5,",DIC(0)="L",DIC("DR")="1////^S X=$G(PSABAL)",(X,DINUM)=$E(DT,1,5)*100,DA(2)=PSALOC,DA(1)=PSADRG,DLAYGO=58.8 D ^DIC K DIC 116 .S X="T-1M" D ^%DT S DIC="^PSD(58.8,"_PSALOC_",1,"_PSADRG_",5,",DIC(0)="L",(X,DINUM)=$E(Y,1,5)*100 D ^DIC K DIC,DLAYGO S DA=+Y 117 .S DA(2)=PSALOC,DA(1)=PSADRG,DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",5,",DR="3////^S X=$G(PSABAL)" D ^DIE K DIE 118 S DA(2)=PSALOC,DA(1)=PSADRG,DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",5,",DA=$E(DT,1,5)*100,DR="5////^S X="_($P($G(^(0)),"^",3)+PSADUREC) D ^DIE K DIE 119 L -^PSD(58.8,PSALOC,1,PSADRG,0) 120 W !,"updating pharmacy location file." 121 FILE581 ;Update transaction file 122 S PSAVDUZ=DUZ 123 FIND S PSAT=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),"^",3)=$P(^PSD(58.81,0),"^",3)+1 G FIND 124 S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC K DIC,DINUM,DLAYGO L -^PSD(58.81,0) 125 S DIE="^PSD(58.81,",DA=PSAT,DR="1////1;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRG;5////^S X=PSADUREC;6////^S X=PSAVDUZ;9////^S X=PSABAL;71////^S X=PSAINV;106////^S X=PSAORD" 126 I $G(PSACS)>0 S DR=DR_";100////^S X=PSACS" 127 F L +^PSD(58.81,DA,0):0 I Q 128 D ^DIE L -^PSD(58.81,DA,0) K DIE W !,"updating transaction file." Q 129 ; 130 HDR W @IOF,!?25,"EDIT VERIFIED INVOICED ITEM SCREEN",!,PSASLN,! 131 W !,?44,"Order",!,"#",?10,"Drug/Item Name",?45,"Unit",?56,"Qnty.",?67,"NDC",!,PSASLN,! Q 132 Q K AN,D,DA,DATA,DIC,DIR,INVARRAY,LINENUM,PSA50IEN,PSABAL,PSABEFOR,PSACS,PSADATA,PSADJ,PSADJFLD,PSADRG,PSADT,PSADUREC,PSAGAIN,PSAIEN,PSAIEN1,PSAIN,PSAINV,PSALINE,PSALINEN 133 K PSALOC,PSANDC,PSAORD,PSAOUT,PSAQTY,PSAREA,PSAREORD,PSASLN,PSASTOCK,PSASUB,PSASUP,PSASUPP,PSAT,PSAVER,X,X1,X2,X3,XX,XXX,Y,PSAODUOU 134 K PSAODU,PSAODUOU,PSAXDUOU 135 Q 136 NOCHNG ;*53 said no to changes, backout the edits on the new drug choice. 137 K DIE,DR,DA 138 S DIE="^PSDRUG(",DA=PSADRG,DR="14.5////^S X=PSAODU;15////^S X=PSAXDUOU" D ^DIE 139 W !,"NO CHANGE",! G Q
Note:
See TracChangeset
for help on using the changeset viewer.