- 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
