APSQDAWP ;IHS/ITSC/ENM/POC - CALCULATE THE AWP [ 08/29/2003 3:14 PM ]
;;6.0;OUTPATIENT PHARMACY;**3,4**;11/11/2002
;ADDED IN ACTUAL ACQISTION COST IHS/OKCAO/POC 11/11/2002
;CALCULATE THE AWP EITHER FORM THE NDC NUMBER IN THE DRUG FILE OR THE NDC NUMBER IN THE ^APSAMDF FILE IHS/OKCAO/POC 8/18/2000 [ 06/04/2001 12:28 PM ]
AWP(NDC,DRUGIEN,MESS) ;EP - NDC NUMBER PASSED MESSAGE IF ANY SENT BACK
;REPLACED MESS WITH MESS("DIMSG",1) 2/16/2001
N DRUGNDC,IENAWP,DISPUNT,DISAWP
N CKDRUG,CKAWP,CKNDCIEN,CKCOST,DISPUNT,DISPDRUG,DISPNAME ;ENHANCED 5/21/2001
;
;LOOKING AT DRUG IN DRUG FILE
;Q:'$G(NDC) 0 ;ADDED FOR PSORXED ROUTINE PSFROM="WHERE FROM I.E. EDIT"ENHANCED 5/21/2001
Q:'$G(DRUGIEN) 0 ;ADDED FOR PSORXED ROUTINE
S (MESS("DIMSG",1),MESS)=""
S DRUGNDC=$P($G(^PSDRUG(DRUGIEN,2)),"^",4)
;I NDC=DRUGNDC S DRUGAWP=$P($G(^PSDRUG(DRUGIEN,999999931)),"^",2) S:DRUGAWP="" MESS="NDC FOR THIS DRUG IN DRUG FILE HAS NO AWP PER DISPENSE UNIT!" Q $FN(DRUGAWP,"",2)
;I NDC=DRUGNDC S DRUGAWP=$P($G(^PSDRUG(DRUGIEN,999999931)),"^",2) S:DRUGAWP="" (MESS("DIMSG",1),MESS)="NDC FOR THIS DRUG IN DRUG FILE HAS NO AWP PER DISPENSE UNIT!" Q $FN(DRUGAWP,"",6)
I ($G(NDC)']"")!(NDC=DRUGNDC) S DRUGAWP=$P($G(^PSDRUG(DRUGIEN,999999931)),"^",2) S:DRUGAWP="" (MESS("DIMSG",1),MESS)="MESSAGE: NDC FOR THIS DRUG IN DRUG FILE HAS NO AWP PER DISPENSE UNIT!" Q $FN(DRUGAWP,"",6) ;ENHANCED 5/21/2001
Q:$G(NDC)']"" 0 ;SHOULD NEVER GET HERE ENHANCED 5/21/2001
;
;NOW LOOKING AT OTHER DRUGS IN DRUG FILE
S (MESS("DIMSG",1),MESS)=""
S NDC=$TR(NDC,"-") ;STRIP OUT DASHES
D Q:$D(CKAWP) CKAWP ;CKAWP IS AWP FROM ANOTHER DRUG IN THE DRUG FILE ENHANCE 5/21/2001
.K CKAWP
.S CKNDCIEN=0 F S CKNDCIEN=$O(^PSDRUG("ZNDC",NDC,CKNDCIEN)) Q:(CKNDCIEN'=+CKNDCIEN)!$D(CKAWP) D
..I $S('$D(^PSDRUG(+CKNDCIEN,"I")):0,DT'>^("I"):0,1:1) Q ;INACTIVE DRUG
..I $P($G(^PSDRUG(+CKNDCIEN,9999999)),U,3)'=+PSOSITE Q ;NOT THIS DIVISION PATCH 4 12/21/2001
..S CKDRUG=$P(^PSDRUG(+CKNDCIEN,0),U,1) ;THIS DRUG NAME
..S CKAWP=$P($G(^PSDRUG(+CKNDCIEN,999999931)),U,2) ;THIS DRUG AWP
..S CKUNT=$P($G(^PSDRUG(+CKNDCIEN,660)),U,5) ;THIS DRUG DISPENSE UNIT PER ORDER UNIT
..S DISPUNT=$P($G(^PSDRUG(DRUGIEN,660)),U,5) ;ORIGINAL DRUG DISPENSE UNIT PER ORDER UNIT
..;S DISPDRUG= ;ORIGINAL DRUG NAME
..I DISPUNT="" S (MESS("DIMSG",1),MESS)="MESSAGE: NO DISPENSE UNIT PER ORDER UNIT FOR THE DRUG IN THIS DRUG IN THE DRUG FILE" S CKAWP=0 Q
..I CKUNT="" S (MESS("DIMSG",1),MESS)="MESSAGE: NO DISPENSE UNIT PER ORDER UNIT FOR TEH DRUG IN THE DRUG FILE "_CKDRUG S CKAWP=0 Q
..I CKUNT'=DISPUNT S (MESS("DIMSG",1),MESS)="WARNING: DRUG DISPENSE UNIT PER ORDER UNIT "_DISPUNT_" FOR THIS DRUG IN DRUG FILE NOT THE SAME AS DRUG DISPENSE UNIT PER ORDER UNIT "_CKUNT_" FOR THE DRUG "_CKDRUG_" IN THE DRUG FILE" Q
..S (MESS("DIMSG",1),MESS)="MESSAGE: NDC'S DRUG FILE NAME IS "_CKDRUG
..Q
.Q
;END OF ENHANCE 5/21/2001
;
;NOW LOOKING AT AWP MED TRANSACTION FILE
;S NDC=$TR(NDC,"-") ;STRIP OUT DASHES
S (MESS("DIMSG",1),MESS)=""
S IENAWP=$O(^APSAMDF("B",NDC,""))
I IENAWP="" S (MESS("DIMSG",1),MESS)="NDC HAS NO AWP ENTRY IN THE AWP MED-TRANSACTION FILE" Q 0
S DISPUNT=$P($G(^PSDRUG(DRUGIEN,660)),"^",5)
I DISPUNT="" S (MESS("DIMSG",1),MESS)="MESSAGE: NO DISPENSE UNITS PER ORDER UNIT FOR THIS DRUG IN DRUG FILE" Q 0
S DISPAWP=$P($G(^APSAMDF(IENAWP,1)),"^",3) ;DISPENSE UNITS PER ORDER UNIT OF AWP FILE
;I DISPUNT'=DISPAWP S DISPNAME=$P($G(^APSAMDF(IENAWP,2)),"^",1),MESS="DRUG DISPENSE UNIT "_DISPUNT_" NOT SAME AS AWP DISPENSE UNIT "_DISPAWP_" FOR DRUG "_DISPNAME Q 0
S DISPNAME=$P($G(^APSAMDF(IENAWP,2)),"^",1),(MESS("DIMSG",1),MESS)="MESSAGE: NDC'S AWP MED TRANSACTION FILE NAME IS "_DISPNAME ;IHS/OKCAO/POC 2/12/2001 CHANGE TO BE LESS RESTRICTIVE
I DISPUNT'=DISPAWP S (MESS("DIMSG",1),MESS)="WARNING: DRUG DISPENSE UNIT PER ORDER UNIT "_DISPUNT_" NOT SAME AS AWP DISPENSE UNIT PER ORDER UNIT "_DISPAWP_" FOR AWP DRUG "_DISPNAME ;IHS/OKCAO/POC 2/12/2001
;ABOVE LINE - WILL SUBSTITUTE THIS LINE FOR ABOVE MAYBE TO ALLOW UNITS NOT TO BE MATCHED UP BUT TAKE FOR ONE DRUG-CHANGE TO BE LESS RESTRICTIVE
;Q $FN($P($G(^APSAMDF(IENAWP,0)),"^",3),"",2) ;AWP PER DISPENSE UNIT
Q $FN($P($G(^APSAMDF(IENAWP,0)),"^",3),"",6) ;AWP PER DISPENSE UNIT
;
COST(NDC,DRUGIEN,MESS) ;EP - NDC NUMBER PASSED MESSAGE IF ANY SENT BACK
;IMPROVE COST
N DRUGNDC,IENAWP,DISPUNT,DISAWP,DISPCOST,COSTPU ;IHS/OCKAO/POC 6/28/2002
N CKDRUG,CKAWP,CKNDCIEN,CKCOST,DISPUNT,DISPDRUG,DISPNAME ;ENHANCED 5/21/2001
;LOOKING AT THE DRUG IN THE DRUG FILE
;Q:'$G(NDC) 0 ;ADDED FOR PSORXED ROUTINE CAN CHECK OUT PSFROM VARIABLEENHANCE 5/21/2001
Q:'$G(DRUGIEN) 0 ;ADDED FOR PSORXED ROUTINE
S (MESS("DIMSG",1),MESS)=""
S DRUGNDC=$P($G(^PSDRUG(DRUGIEN,2)),"^",4)
;I NDC=DRUGNDC S DRUGAWP=$P($G(^PSDRUG(DRUGIEN,999999931)),"^",2) S:DRUGAWP="" MESS="NDC FOR THIS DRUG IN DRUG FILE HAS NO AWP PER DISPENSE UNIT!" Q $FN(DRUGAWP,"",2)
;I NDC=DRUGNDC S DRUGCOST=$P($G(^PSDRUG(DRUGIEN,660)),"^",6) S:DRUGCOST="" (MESS("DIMSG",1),MESS)="NDC FOR THIS DRUG IN DRUG FILE HAS NO AWP PER DISPENSE UNIT!" Q $FN(DRUGCOST,"",6)
I ($G(NDC)']"")!(NDC=DRUGNDC) S DRUGCOST=$P($G(^PSDRUG(DRUGIEN,660)),"^",6) S:DRUGCOST="" (MESS("DIMSG",1),MESS)="NDC FOR THIS DRUG IN DRUG FILE HAS NO AAC PER DISPENSE UNIT!" Q $FN(DRUGCOST,"",6) ;ENHANCE 5/21/2001
Q:$G(NDC)']"" 0 ;SHOULD NEVER GET HERE ENHANCE 5/21/2001
;
;LOOKING AT OTHER DRUGS IN THE DRUG FILE ENHANCE 5/21/2001
S (MESS("DIMSG",1),MESS)=""
S NDC=$TR(NDC,"-") ;STRIP OUT DASHES
D Q:$D(CKCOST) CKCOST
.K CKCOST
.S CKNDCIEN=0 F S CKNDCIEN=$O(^PSDRUG("ZNDC",NDC,CKNDCIEN)) Q:((CKNDCIEN'=+CKNDCIEN)!$D(CKCOST)) D
..I $S('$D(^PSDRUG(+CKNDCIEN,"I")):0,DT'>^("I"):0,1:1) Q ;INACTIVE DRUG
..I $P($G(^PSDRUG(+CKNDCIEN,9999999)),U,3)'=+PSOSITE Q ;NOT THIS DIVISION PATCH 4
..S CKDRUG=$P(^PSDRUG(+CKNDCIEN,0),U,1) ;THIS DRUG NAME
..S CKCOST=$P($G(^PSDRUG(+CKNDCIEN,660)),U,6) ;THIS DRUG COST
..S CKUNT=$P($G(^PSDRUG(+CKNDCIEN,660)),U,5) ;THIS DRUG DISPENSE UNIT PER ORDER UNIT
..S DISPUNT=$P($G(^PSDRUG(DRUGIEN,660)),U,5) ;THE ORIGINAL DRUG DISPENSE UNIT PER ORDER UNIT
..I DISPUNT="" S (MESS("DIMSG",1),MESS)="MESSAGE: NO DISPENSE UNIT PER ORDER UNIT FOR THIS DRUG IN DRUG FILE" S CKCOST=0 Q
..I CKUNT="" S (MESS("DIMSG",1),MESS)="MESSAGE: NO DISPENSE UNIT PER ORDER UNIT FOR THE DRUG IN THE DRUG FILE "_CKDRUG S CKCOST=0 Q
..I CKUNT'=DISPUNT S (MESS("DIMSG",1),MESS)="WARNING: DRUG DISPENSE UNIT PER ORDER UNIT OF "_DISPUNT_" FOR THIS DRUG NOT THE SAME AS DRUG DISPENSE UNIT PER ORDER UNIT OF "_CKUNT_" FOR THE DRUG "_CKDRUG Q
..S (MESS("DIMSG",1),MESS)="MESSAGE: NDC'S DRUG FILE NAME IS "_CKDRUG
..Q
.Q
;END OF CHANGES ENHANCE 5/21/2001
;
;BELOW ARE CHANGES FOR COST IHS/OKCAO/POC 6/28/2002
S (MESS("DIMSG",1),MESS)=""
;S NDC=$TR(NDC,"-") ;STRIP OUT DASHES
S IENAWP=$O(^APSAMDF("B",NDC,"")) ;&&
I IENAWP="" S (MESS("DIMSG",1),MESS)="NDC HAS NO COST ENTRY IN THE AWP MED-TRANSACTION FILE" Q 0
S DISPUNT=$P($G(^PSDRUG(DRUGIEN,660)),"^",5)
I DISPUNT="" S (MESS("DIMSG",1),MESS)="NO DISPENSE UNITS PER ORDER UNIT FOR THIS DRUG" Q 0
S DISPCOST=$P($G(^APSAMDF(IENAWP,1)),"^",3) ;***DISPENSE UNITS PER ORDER UNIT OF SOME COST FILE ;&&
S DISPNAME=$P($G(^APSAMDF(IENAWP,2)),"^",1),(MESS("DIMSG",1),MESS)="MESSAGE: NDC'S COST MED TRANSACTION FILE NAME IS "_DISPNAME
I DISPUNT'=DISPCOST S (MESS("DIMSG",1),MESS)="WARNING: DRUG DISPENSE UNIT PER ORDER UNIT "_DISPUNT_" NOT SAME AS COST DISPENSE UNIT PER ORDER UNIT "_DISPCOST_" FOR COST DRUG "_DISPNAME
S COSTPU=$FN($P($G(^APSAMDF(IENAWP,4)),"^",3),"",6) ;COST PER UNIT OF COST DRUG FIELD 403 IN AWP FILE
I 'COSTPU S (MESS("DIMSG",1),MESS)="WARNING: NO COST PER DISPENSE UNIT PER ORDER UNIT FOR THIS DRUG ENTRY "_DISPNAME_" IN COST FILE"
Q COSTPU
APSQDAWP ;IHS/ITSC/ENM/POC - CALCULATE THE AWP [ 08/29/2003 3:14 PM ]
+1 ;;6.0;OUTPATIENT PHARMACY;**3,4**;11/11/2002
+2 ;ADDED IN ACTUAL ACQISTION COST IHS/OKCAO/POC 11/11/2002
+3 ;CALCULATE THE AWP EITHER FORM THE NDC NUMBER IN THE DRUG FILE OR THE NDC NUMBER IN THE ^APSAMDF FILE IHS/OKCAO/POC 8/18/2000 [ 06/04/2001 12:28 PM ]
AWP(NDC,DRUGIEN,MESS) ;EP - NDC NUMBER PASSED MESSAGE IF ANY SENT BACK
+1 ;REPLACED MESS WITH MESS("DIMSG",1) 2/16/2001
+2 NEW DRUGNDC,IENAWP,DISPUNT,DISAWP
+3 ;ENHANCED 5/21/2001
NEW CKDRUG,CKAWP,CKNDCIEN,CKCOST,DISPUNT,DISPDRUG,DISPNAME
+4 ;
+5 ;LOOKING AT DRUG IN DRUG FILE
+6 ;Q:'$G(NDC) 0 ;ADDED FOR PSORXED ROUTINE PSFROM="WHERE FROM I.E. EDIT"ENHANCED 5/21/2001
+7 ;ADDED FOR PSORXED ROUTINE
IF '$GET(DRUGIEN)
QUIT 0
+8 SET (MESS("DIMSG",1),MESS)=""
+9 SET DRUGNDC=$PIECE($GET(^PSDRUG(DRUGIEN,2)),"^",4)
+10 ;I NDC=DRUGNDC S DRUGAWP=$P($G(^PSDRUG(DRUGIEN,999999931)),"^",2) S:DRUGAWP="" MESS="NDC FOR THIS DRUG IN DRUG FILE HAS NO AWP PER DISPENSE UNIT!" Q $FN(DRUGAWP,"",2)
+11 ;I NDC=DRUGNDC S DRUGAWP=$P($G(^PSDRUG(DRUGIEN,999999931)),"^",2) S:DRUGAWP="" (MESS("DIMSG",1),MESS)="NDC FOR THIS DRUG IN DRUG FILE HAS NO AWP PER DISPENSE UNIT!" Q $FN(DRUGAWP,"",6)
+12 ;ENHANCED 5/21/2001
IF ($GET(NDC)']"")!(NDC=DRUGNDC)
SET DRUGAWP=$PIECE($GET(^PSDRUG(DRUGIEN,999999931)),"^",2)
IF DRUGAWP=""
SET (MESS("DIMSG",1),MESS)="MESSAGE: NDC FOR THIS DRUG IN DRUG FILE HAS NO AWP PER DISPENSE UNIT!"
QUIT $FNUMBER(DRUGAWP,"",6)
+13 ;SHOULD NEVER GET HERE ENHANCED 5/21/2001
IF $GET(NDC)']""
QUIT 0
+14 ;
+15 ;NOW LOOKING AT OTHER DRUGS IN DRUG FILE
+16 SET (MESS("DIMSG",1),MESS)=""
+17 ;STRIP OUT DASHES
SET NDC=$TRANSLATE(NDC,"-")
+18 ;CKAWP IS AWP FROM ANOTHER DRUG IN THE DRUG FILE ENHANCE 5/21/2001
Begin DoDot:1
+19 KILL CKAWP
+20 SET CKNDCIEN=0
FOR
SET CKNDCIEN=$ORDER(^PSDRUG("ZNDC",NDC,CKNDCIEN))
IF (CKNDCIEN'=+CKNDCIEN)!$DATA(CKAWP)
QUIT
Begin DoDot:2
+21 ;INACTIVE DRUG
IF $SELECT('$DATA(^PSDRUG(+CKNDCIEN,"I")):0,DT'>^("I"):0,1:1)
QUIT
+22 ;NOT THIS DIVISION PATCH 4 12/21/2001
IF $PIECE($GET(^PSDRUG(+CKNDCIEN,9999999)),U,3)'=+PSOSITE
QUIT
+23 ;THIS DRUG NAME
SET CKDRUG=$PIECE(^PSDRUG(+CKNDCIEN,0),U,1)
+24 ;THIS DRUG AWP
SET CKAWP=$PIECE($GET(^PSDRUG(+CKNDCIEN,999999931)),U,2)
+25 ;THIS DRUG DISPENSE UNIT PER ORDER UNIT
SET CKUNT=$PIECE($GET(^PSDRUG(+CKNDCIEN,660)),U,5)
+26 ;ORIGINAL DRUG DISPENSE UNIT PER ORDER UNIT
SET DISPUNT=$PIECE($GET(^PSDRUG(DRUGIEN,660)),U,5)
+27 ;S DISPDRUG= ;ORIGINAL DRUG NAME
+28 IF DISPUNT=""
SET (MESS("DIMSG",1),MESS)="MESSAGE: NO DISPENSE UNIT PER ORDER UNIT FOR THE DRUG IN THIS DRUG IN THE DRUG FILE"
SET CKAWP=0
QUIT
+29 IF CKUNT=""
SET (MESS("DIMSG",1),MESS)="MESSAGE: NO DISPENSE UNIT PER ORDER UNIT FOR TEH DRUG IN THE DRUG FILE "_CKDRUG
SET CKAWP=0
QUIT
+30 IF CKUNT'=DISPUNT
SET (MESS("DIMSG",1),MESS)="WARNING: DRUG DISPENSE UNIT PER ORDER UNIT "_DISPUNT_" FOR THIS DRUG IN DRUG FILE NOT THE SAME AS DRUG DISPENSE UNIT PER ORDER UNIT "_CKUNT_" FOR THE DRUG "_CKDRUG_" IN THE DRUG FILE"
QUIT
+31 SET (MESS("DIMSG",1),MESS)="MESSAGE: NDC'S DRUG FILE NAME IS "_CKDRUG
+32 QUIT
End DoDot:2
+33 QUIT
End DoDot:1
IF $DATA(CKAWP)
QUIT CKAWP
+34 ;END OF ENHANCE 5/21/2001
+35 ;
+36 ;NOW LOOKING AT AWP MED TRANSACTION FILE
+37 ;S NDC=$TR(NDC,"-") ;STRIP OUT DASHES
+38 SET (MESS("DIMSG",1),MESS)=""
+39 SET IENAWP=$ORDER(^APSAMDF("B",NDC,""))
+40 IF IENAWP=""
SET (MESS("DIMSG",1),MESS)="NDC HAS NO AWP ENTRY IN THE AWP MED-TRANSACTION FILE"
QUIT 0
+41 SET DISPUNT=$PIECE($GET(^PSDRUG(DRUGIEN,660)),"^",5)
+42 IF DISPUNT=""
SET (MESS("DIMSG",1),MESS)="MESSAGE: NO DISPENSE UNITS PER ORDER UNIT FOR THIS DRUG IN DRUG FILE"
QUIT 0
+43 ;DISPENSE UNITS PER ORDER UNIT OF AWP FILE
SET DISPAWP=$PIECE($GET(^APSAMDF(IENAWP,1)),"^",3)
+44 ;I DISPUNT'=DISPAWP S DISPNAME=$P($G(^APSAMDF(IENAWP,2)),"^",1),MESS="DRUG DISPENSE UNIT "_DISPUNT_" NOT SAME AS AWP DISPENSE UNIT "_DISPAWP_" FOR DRUG "_DISPNAME Q 0
+45 ;IHS/OKCAO/POC 2/12/2001 CHANGE TO BE LESS RESTRICTIVE
SET DISPNAME=$PIECE($GET(^APSAMDF(IENAWP,2)),"^",1)
SET (MESS("DIMSG",1),MESS)="MESSAGE: NDC'S AWP MED TRANSACTION FILE NAME IS "_DISPNAME
+46 ;IHS/OKCAO/POC 2/12/2001
IF DISPUNT'=DISPAWP
SET (MESS("DIMSG",1),MESS)="WARNING: DRUG DISPENSE UNIT PER ORDER UNIT "_DISPUNT_" NOT SAME AS AWP DISPENSE UNIT PER ORDER UNIT "_DISPAWP_" FOR AWP DRUG "_DISPNAME
+47 ;ABOVE LINE - WILL SUBSTITUTE THIS LINE FOR ABOVE MAYBE TO ALLOW UNITS NOT TO BE MATCHED UP BUT TAKE FOR ONE DRUG-CHANGE TO BE LESS RESTRICTIVE
+48 ;Q $FN($P($G(^APSAMDF(IENAWP,0)),"^",3),"",2) ;AWP PER DISPENSE UNIT
+49 ;AWP PER DISPENSE UNIT
QUIT $FNUMBER($PIECE($GET(^APSAMDF(IENAWP,0)),"^",3),"",6)
+50 ;
COST(NDC,DRUGIEN,MESS) ;EP - NDC NUMBER PASSED MESSAGE IF ANY SENT BACK
+1 ;IMPROVE COST
+2 ;IHS/OCKAO/POC 6/28/2002
NEW DRUGNDC,IENAWP,DISPUNT,DISAWP,DISPCOST,COSTPU
+3 ;ENHANCED 5/21/2001
NEW CKDRUG,CKAWP,CKNDCIEN,CKCOST,DISPUNT,DISPDRUG,DISPNAME
+4 ;LOOKING AT THE DRUG IN THE DRUG FILE
+5 ;Q:'$G(NDC) 0 ;ADDED FOR PSORXED ROUTINE CAN CHECK OUT PSFROM VARIABLEENHANCE 5/21/2001
+6 ;ADDED FOR PSORXED ROUTINE
IF '$GET(DRUGIEN)
QUIT 0
+7 SET (MESS("DIMSG",1),MESS)=""
+8 SET DRUGNDC=$PIECE($GET(^PSDRUG(DRUGIEN,2)),"^",4)
+9 ;I NDC=DRUGNDC S DRUGAWP=$P($G(^PSDRUG(DRUGIEN,999999931)),"^",2) S:DRUGAWP="" MESS="NDC FOR THIS DRUG IN DRUG FILE HAS NO AWP PER DISPENSE UNIT!" Q $FN(DRUGAWP,"",2)
+10 ;I NDC=DRUGNDC S DRUGCOST=$P($G(^PSDRUG(DRUGIEN,660)),"^",6) S:DRUGCOST="" (MESS("DIMSG",1),MESS)="NDC FOR THIS DRUG IN DRUG FILE HAS NO AWP PER DISPENSE UNIT!" Q $FN(DRUGCOST,"",6)
+11 ;ENHANCE 5/21/2001
IF ($GET(NDC)']"")!(NDC=DRUGNDC)
SET DRUGCOST=$PIECE($GET(^PSDRUG(DRUGIEN,660)),"^",6)
IF DRUGCOST=""
SET (MESS("DIMSG",1),MESS)="NDC FOR THIS DRUG IN DRUG FILE HAS NO AAC PER DISPENSE UNIT!"
QUIT $FNUMBER(DRUGCOST,"",6)
+12 ;SHOULD NEVER GET HERE ENHANCE 5/21/2001
IF $GET(NDC)']""
QUIT 0
+13 ;
+14 ;LOOKING AT OTHER DRUGS IN THE DRUG FILE ENHANCE 5/21/2001
+15 SET (MESS("DIMSG",1),MESS)=""
+16 ;STRIP OUT DASHES
SET NDC=$TRANSLATE(NDC,"-")
+17 Begin DoDot:1
+18 KILL CKCOST
+19 SET CKNDCIEN=0
FOR
SET CKNDCIEN=$ORDER(^PSDRUG("ZNDC",NDC,CKNDCIEN))
IF ((CKNDCIEN'=+CKNDCIEN)!$DATA(CKCOST))
QUIT
Begin DoDot:2
+20 ;INACTIVE DRUG
IF $SELECT('$DATA(^PSDRUG(+CKNDCIEN,"I")):0,DT'>^("I"):0,1:1)
QUIT
+21 ;NOT THIS DIVISION PATCH 4
IF $PIECE($GET(^PSDRUG(+CKNDCIEN,9999999)),U,3)'=+PSOSITE
QUIT
+22 ;THIS DRUG NAME
SET CKDRUG=$PIECE(^PSDRUG(+CKNDCIEN,0),U,1)
+23 ;THIS DRUG COST
SET CKCOST=$PIECE($GET(^PSDRUG(+CKNDCIEN,660)),U,6)
+24 ;THIS DRUG DISPENSE UNIT PER ORDER UNIT
SET CKUNT=$PIECE($GET(^PSDRUG(+CKNDCIEN,660)),U,5)
+25 ;THE ORIGINAL DRUG DISPENSE UNIT PER ORDER UNIT
SET DISPUNT=$PIECE($GET(^PSDRUG(DRUGIEN,660)),U,5)
+26 IF DISPUNT=""
SET (MESS("DIMSG",1),MESS)="MESSAGE: NO DISPENSE UNIT PER ORDER UNIT FOR THIS DRUG IN DRUG FILE"
SET CKCOST=0
QUIT
+27 IF CKUNT=""
SET (MESS("DIMSG",1),MESS)="MESSAGE: NO DISPENSE UNIT PER ORDER UNIT FOR THE DRUG IN THE DRUG FILE "_CKDRUG
SET CKCOST=0
QUIT
+28 IF CKUNT'=DISPUNT
SET (MESS("DIMSG",1),MESS)="WARNING: DRUG DISPENSE UNIT PER ORDER UNIT OF "_DISPUNT_" FOR THIS DRUG NOT THE SAME AS DRUG DISPENSE UNIT PER ORDER UNIT OF "_CKUNT_" FOR THE DRUG "_CKDRUG
QUIT
+29 SET (MESS("DIMSG",1),MESS)="MESSAGE: NDC'S DRUG FILE NAME IS "_CKDRUG
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
IF $DATA(CKCOST)
QUIT CKCOST
+32 ;END OF CHANGES ENHANCE 5/21/2001
+33 ;
+34 ;BELOW ARE CHANGES FOR COST IHS/OKCAO/POC 6/28/2002
+35 SET (MESS("DIMSG",1),MESS)=""
+36 ;S NDC=$TR(NDC,"-") ;STRIP OUT DASHES
+37 ;&&
SET IENAWP=$ORDER(^APSAMDF("B",NDC,""))
+38 IF IENAWP=""
SET (MESS("DIMSG",1),MESS)="NDC HAS NO COST ENTRY IN THE AWP MED-TRANSACTION FILE"
QUIT 0
+39 SET DISPUNT=$PIECE($GET(^PSDRUG(DRUGIEN,660)),"^",5)
+40 IF DISPUNT=""
SET (MESS("DIMSG",1),MESS)="NO DISPENSE UNITS PER ORDER UNIT FOR THIS DRUG"
QUIT 0
+41 ;***DISPENSE UNITS PER ORDER UNIT OF SOME COST FILE ;&&
SET DISPCOST=$PIECE($GET(^APSAMDF(IENAWP,1)),"^",3)
+42 SET DISPNAME=$PIECE($GET(^APSAMDF(IENAWP,2)),"^",1)
SET (MESS("DIMSG",1),MESS)="MESSAGE: NDC'S COST MED TRANSACTION FILE NAME IS "_DISPNAME
+43 IF DISPUNT'=DISPCOST
SET (MESS("DIMSG",1),MESS)="WARNING: DRUG DISPENSE UNIT PER ORDER UNIT "_DISPUNT_" NOT SAME AS COST DISPENSE UNIT PER ORDER UNIT "_DISPCOST_" FOR COST DRUG "_DISPNAME
+44 ;COST PER UNIT OF COST DRUG FIELD 403 IN AWP FILE
SET COSTPU=$FNUMBER($PIECE($GET(^APSAMDF(IENAWP,4)),"^",3),"",6)
+45 IF 'COSTPU
SET (MESS("DIMSG",1),MESS)="WARNING: NO COST PER DISPENSE UNIT PER ORDER UNIT FOR THIS DRUG ENTRY "_DISPNAME_" IN COST FILE"
+46 QUIT COSTPU
