Changeset 623 for WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAUTL4.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/PSAUTL4.m
r613 r623 1 PSAUTL4 ;BIR ISC/JMB-Verify Invoices Utility ; 8/19/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,48,54,61,67**; 10/24/97;Build 15 3 ; 4 ;References to ^DIC(51.5 are covered by IA #1931 5 ;References to ^PSDRUG( are covered by IA #2095 6 I $G(PSADICW)=1 S PSALINE=Y 7 ;This routine contains a utility to display a line item ready for 8 ;verification. It is called by PSAVER1 and PSAVER2. 9 ; 10 VERDISP ;Displays a line item on a processed or verified invoice 11 W PSALINEN_" " 12 DRUG S PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0)) 13 I $G(PSADJ) D 14 .S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)) 15 .S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 16 .I PSADJD'?1.N S PSASUP=1 17 .S PSADRG=$S(PSADJ&('PSASUP):$G(PSADJD),PSADJ&(PSASUP):0,1:+$P(PSADATA,"^",2)) 18 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" W "*"_$P($G(^PSDRUG(+PSADJD,0)),"^") S (PSADRG,PSA50IEN)=+PSADJD Q 19 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S (PSADJ,PSADRG)=0 Q 20 .W ?7,"**"_PSADJD S PSADJSUP=1,(PSADRG,PSA50IEN)=PSADJD 21 I '$G(PSADJ) D 22 .S (PSA50IEN,PSADRG)=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0) 23 .W $S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):$P(^PSDRUG(+$P(PSADATA,"^",2),0),"^"),1:"DRUG UNKNOWN") 24 I PSADRG D 25 .I $P($G(^PSDRUG(PSADRG,2)),"^",3)["N" W " (Controlled Substance)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN MASTER VAULT **" 26 .I $D(^PSDRUG(PSADRG,"I")) W !?5,"** INACTIVE IN DRUG FILE **" Q 27 .I $P($G(^PSD(58.8,+$P(PSAIN,"^",5),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN PHARMACY LOCATION **" 28 QTY W !,"Qty Invoiced: " 29 ;No Adj. Qty 30 S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0)) 31 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 32 ;Adj. Qty 33 I $G(PSADJQ) S PSAQTY=PSADJQ W PSAQTY_" ("_$S($P(PSADATA,"^",3):$P(PSADATA,"^",3),$P(PSADATA,"^",3)=0:0,1:"Blank")_")" 34 I '$G(PSADJQ) W $P(PSADATA,"^",3) S PSAQTY=$P(PSADATA,"^",3) 35 UPC S PSAUPC=$P(PSADATA,U,13) W:PSAUPC'="" ?38,"UPC: "_PSAUPC 36 OU W !,"Order Unit : " 37 S PSAOU=$S(+$P(PSADATA,"^",4)&($P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^")'=""):+$P(PSADATA,"^",4),1:"") 38 S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)) 39 I +$P(PSATEMP,"^",3),PSADRG,+$P($G(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0)),"^",5) S PSAOU=+$P(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0),"^",5) 40 S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0)) 41 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJO=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 42 ;Adj. Order Unit 43 I PSADJO'="" W $S(+PSADJO&($P($G(^DIC(51.5,+PSADJO,0)),"^")'=""):$P($G(^DIC(51.5,+PSADJO,0)),"^"),1:"UNKNOWN")_" ("_$S(PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank")_")" S PSAOU=+PSADJO 44 I PSADJO="" W $S(+PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank") 45 ; 46 NDC S PSANDC=$P(PSADATA,"^",11) 47 I $E(PSANDC)'="S" W ?38,"NDC: " D PSANDC1^PSAHELP W PSANDCX K PSANDCX 48 ; 49 PRICE W !,"Unit Price : $" 50 S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0)) 51 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJP=$S(+$P(PSANODE,"^",6):+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2)) 52 ;Adj. Unit Price 53 I $G(PSADJP) D 54 .I $L($P(PSADJP,".",2))<2 S PSADJP=$P(PSADJP,".")_"."_$P(PSADJP,".",2)_$E("00",1,(2-$L($P(PSADJP,".",2)))) 55 .W $FN(PSADJP,",")_" ($"_$S(+$P(PSADATA,"^",5):$FN($P(PSADATA,"^",5),","),$P(PSADATA,"^",5)=0:"0.00",1:"")_")" 56 .S PSAPRICE=PSADJP 57 I '$G(PSADJP) D 58 .S PSAPRICE=+$P(PSADATA,"^",5) 59 .I $G(PSAPRICE)!(PSAPRICE=0) W $S($G(PSAPRICE):PSAPRICE,1:"0.00") Q 60 .W "Blank" 61 ; 62 VSN S:$D(PSADATA) PSAVSN=$P(PSADATA,"^",12) ;*48 63 W ?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),! 64 ;bgn *67 65 S PSAP67=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,3,PSALINE,0)) 66 W !,"PV-Drug-Description : ",$S($P(PSAP67,"^",1)'="":$P(PSAP67,"^",1),1:"Unknown") 67 W ?55,"PV-DUOU : ",$S($P(PSAP67,"^",4)'="":$P(PSAP67,"^",4),1:"Unknown") 68 W !,"PV-Drug-Generic Name : ",$S($P(PSAP67,"^",2)'="":$P(PSAP67,"^",2),1:"Unknown") 69 W ?55,"PV-UNITS : ",$S($P(PSAP67,"^",3)'="":$P(PSAP67,"^",3),1:"Unknown"),! 70 ;end *67 71 VDU S PSADUOU=+$P(PSATEMP,"^"),PSAREORD=+$P(PSATEMP,"^",2),PSASUB=+$P(PSATEMP,"^",3),PSASTOCK=+$P(PSATEMP,"^",4) 72 W !,"Dispense Units: "_$S($P($G(^PSDRUG(+PSADRG,660)),"^",8)'="":$P($G(^PSDRUG(+PSADRG,660)),"^",8),1:"Blank") 73 VDUOU W !,"Dispense Units Per Order Unit: "_$S(+PSADUOU:+PSADUOU,+PSASUB&(+$P($G(^PSDRUG(+PSADRG,1,PSASUB,0)),"^",7)):+$P($G(^PSDRUG(+PSADRG,1,PSASUB,0)),"^",7),1:"Blank"),! 74 ; 75 Q:'+$P($G(^PSD(58.8,+PSALOC,0)),"^",14) 76 ; 77 STOCK S PSASTOCK=$S(+PSASTOCK:+PSASTOCK,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3),1:"Blank") 78 W "Stock Level : "_PSASTOCK 79 REORDER S PSAREORD=$S(+PSAREORD:+PSAREORD,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5),1:"Blank") 80 W !,"Reorder Level : "_PSAREORD,! 81 Q 1 PSAUTL4 ;BIR ISC/JMB-Verify Invoices Utility ; 8/19/97 2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,21,48,54,61**; 10/24/97;Build 1 3 ; 4 ;References to ^DIC(51.5 are covered by IA #1931 5 ;References to ^PSDRUG( are covered by IA #2095 6 I $G(PSADICW)=1 S PSALINE=Y 7 ;This routine contains a utility to display a line item ready for 8 ;verification. It is called by PSAVER1 and PSAVER2. 9 ; 10 VERDISP ;Displays a line item on a processed or verified invoice 11 W PSALINEN_" " 12 DRUG S PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0)) 13 I $G(PSADJ) D 14 .S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)) 15 .S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 16 .I PSADJD'?1.N S PSASUP=1 17 .S PSADRG=$S(PSADJ&('PSASUP):$G(PSADJD),PSADJ&(PSASUP):0,1:+$P(PSADATA,"^",2)) 18 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" W "*"_$P($G(^PSDRUG(+PSADJD,0)),"^") S (PSADRG,PSA50IEN)=+PSADJD Q 19 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S (PSADJ,PSADRG)=0 Q 20 .W ?7,"**"_PSADJD S PSADJSUP=1,(PSADRG,PSA50IEN)=PSADJD 21 I '$G(PSADJ) D 22 .S (PSA50IEN,PSADRG)=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0) 23 .W $S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):$P(^PSDRUG(+$P(PSADATA,"^",2),0),"^"),1:"DRUG UNKNOWN") 24 I PSADRG D 25 .I $P($G(^PSDRUG(PSADRG,2)),"^",3)["N" W " (Controlled Substance)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN MASTER VAULT **" 26 .I $D(^PSDRUG(PSADRG,"I")) W !?5,"** INACTIVE IN DRUG FILE **" Q 27 .I $P($G(^PSD(58.8,+$P(PSAIN,"^",5),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !,$C(7),$C(7),"** INACTIVE IN PHARMACY LOCATION **" 28 QTY W !,"Qty Invoiced: " 29 ;No Adj. Qty 30 S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0)) 31 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 32 ;Adj. Qty 33 I $G(PSADJQ) S PSAQTY=PSADJQ W PSAQTY_" ("_$S($P(PSADATA,"^",3):$P(PSADATA,"^",3),$P(PSADATA,"^",3)=0:0,1:"Blank")_")" 34 I '$G(PSADJQ) W $P(PSADATA,"^",3) S PSAQTY=$P(PSADATA,"^",3) 35 UPC S PSAUPC=$P(PSADATA,U,13) W:PSAUPC'="" ?38,"UPC: "_PSAUPC 36 OU W !,"Order Unit : " 37 S PSAOU=$S(+$P(PSADATA,"^",4)&($P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^")'=""):+$P(PSADATA,"^",4),1:"") 38 S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2)) 39 I +$P(PSATEMP,"^",3),PSADRG,+$P($G(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0)),"^",5) S PSAOU=+$P(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0),"^",5) 40 S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0)) 41 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJO=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2)) 42 ;Adj. Order Unit 43 I PSADJO'="" W $S(+PSADJO&($P($G(^DIC(51.5,+PSADJO,0)),"^")'=""):$P($G(^DIC(51.5,+PSADJO,0)),"^"),1:"UNKNOWN")_" ("_$S(PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank")_")" S PSAOU=+PSADJO 44 I PSADJO="" W $S(+PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank") 45 ; 46 NDC S PSANDC=$P(PSADATA,"^",11) 47 I $E(PSANDC)'="S" W ?38,"NDC: " D PSANDC1^PSAHELP W PSANDCX K PSANDCX 48 ; 49 PRICE W !,"Unit Price : $" 50 S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0)) 51 I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJP=$S(+$P(PSANODE,"^",6):+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2)) 52 ;Adj. Unit Price 53 I $G(PSADJP) D 54 .I $L($P(PSADJP,".",2))<2 S PSADJP=$P(PSADJP,".")_"."_$P(PSADJP,".",2)_$E("00",1,(2-$L($P(PSADJP,".",2)))) 55 .W $FN(PSADJP,",")_" ($"_$S(+$P(PSADATA,"^",5):$FN($P(PSADATA,"^",5),","),$P(PSADATA,"^",5)=0:"0.00",1:"")_")" 56 .S PSAPRICE=PSADJP 57 I '$G(PSADJP) D 58 .S PSAPRICE=+$P(PSADATA,"^",5) 59 .I $G(PSAPRICE)!(PSAPRICE=0) W $S($G(PSAPRICE):PSAPRICE,1:"0.00") Q 60 .W "Blank" 61 ; 62 VSN S:$D(PSADATA) PSAVSN=$P(PSADATA,"^",12) ;*48 63 W ?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),! 64 ;*54 display VSN XTMP Drug Description and DUOU |==> 65 N PSAFLDT S PSAFLDT="February 2006" 66 N XXX I PSAVSN'="" S XXX=$G(^XTMP("PSAVSN",PSAVSN)) D 67 . I $G(^XTMP("PSAVSN",0)) S PSAFLDT=$P(^XTMP("PSAVSN",0),"^",4) 68 . W !,"PV-Drug-Descrip: " 69 . I '$L(XXX) W "Not Available. Item is OTC or new after ",PSAFLDT,! Q 70 . W ?20,$P(XXX,"~",2),?55,"PV-DUOU: ",+XXX,! 71 ;*54 display VSN XTMP Drug Description and DUOU <==| 72 VDU S PSADUOU=+$P(PSATEMP,"^"),PSAREORD=+$P(PSATEMP,"^",2),PSASUB=+$P(PSATEMP,"^",3),PSASTOCK=+$P(PSATEMP,"^",4) 73 W !,"Dispense Units: "_$S($P($G(^PSDRUG(+PSADRG,660)),"^",8)'="":$P($G(^PSDRUG(+PSADRG,660)),"^",8),1:"Blank") 74 VDUOU W !,"Dispense Units Per Order Unit: "_$S(+PSADUOU:+PSADUOU,+PSASUB&(+$P($G(^PSDRUG(+PSADRG,1,PSASUB,0)),"^",7)):+$P($G(^PSDRUG(+PSADRG,1,PSASUB,0)),"^",7),1:"Blank"),! 75 ; 76 Q:'+$P($G(^PSD(58.8,+PSALOC,0)),"^",14) 77 ; 78 STOCK S PSASTOCK=$S(+PSASTOCK:+PSASTOCK,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3),1:"Blank") 79 W "Stock Level : "_PSASTOCK 80 REORDER S PSAREORD=$S(+PSAREORD:+PSAREORD,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5),1:"Blank") 81 W !,"Reorder Level : "_PSAREORD,! 82 Q
Note:
See TracChangeset
for help on using the changeset viewer.