Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSANDF

PSANDF.m

Go to the documentation of this file.
  1. PSANDF ;BIR/JMB-Process Uploaded Prime Vendor Invoice Data - CONT'D ;7/23/97
  1. ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**8,11,58**; 10/24/97
  1. ;This routine searches NDF for the NDC. If it is not found, the user
  1. ;is asked to select the drug from the DRUG file.
  1. ;
  1. I PSANDC="",$P(PSADATA,"^",26)'="" D Q
  1. .I +$P($P(PSADATA,"^",26),"~",2) D
  1. ..K PSASUP S PSASUP="S"_$P(PSADATA,"^",26),(PSACNT,PSAIEN50)=0
  1. ..F S PSAIEN50=$O(^PSDRUG("C",PSASUP,PSAIEN50)) Q:PSAIEN50="" D
  1. ...S PSASSUB=0 F S PSASSUB=$O(^PSDRUG("C",PSASUP,PSAIEN50,PSASSUB)) Q:'PSASSUB S PSACNT=PSACNT+1,PSASUP(PSACNT)=PSAIEN50_"^"_PSASSUB
  1. ..I 'PSACNT D Q
  1. ...W !,"The vendor sent no NDC or UPC for the item."
  1. ...D ASKDRUG S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
  1. ..I PSACNT=1 D Q
  1. ...S PSAIEN=$P(PSASUP(1),"^"),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",6)=PSAIEN,PSASUB=$P(PSASUP(1),"^",2),$P(^(PSALINE),"^",7)=PSASUB
  1. ...S PSANDC=PSASUP,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,PSAVSN=$P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^",4),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",5)=PSAVSN
  1. ...S PSADATA=^XTMP("PSAPV",PSACTRL,"IT",PSALINE)
  1. ..I PSACNT>1 S PSACNT=$O(PSASUP(0)) D:PSACNT MANYUPCS^PSAPROC5
  1. ;
  1. LOOKNDF S PSACNT=0,X=$$PSA^PSNAPIS(PSANDC,.PSALIST),PSACNT=X
  1. K ^TMP("PSANDF",$J) S X=0 F S X=$O(PSALIST(X)) Q:X'>0 S ^TMP("PSANDF",$J,X)=PSALIST(X)
  1. ;
  1. ;DAVEB (PSA*3*11)
  1. I $D(^TMP("PSANDF",$J)) S XX=$O(^TMP("PSANDF",$J,0)),PSAVAPN=$P($G(^PSDRUG(XX,"ND")),"^",2) K XX
  1. I $G(PSACNT)>0 S X=0 F S X=$O(PSALIST(X)) Q:X'>0 I '$D(^PSDRUG(X,"I")) S ^TMP("PSANDF",$J,X)=$P(PSALIST(X),"^")
  1. I '$D(PSAVAPN),$D(PSALIST) S PSAVAPN=$O(PSALIST(0)),PSAVAPN=$S('$D(^PSDRUG(PSAVAPN,"ND")):"Unknown",1:$P($G(^PSDRUG(PSAVAPN,"ND")),"^",2))
  1. K PSALIST,X
  1. NONE I 'PSACNT D Q
  1. .I +$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~",2)!($P($P(^(PSALINE),"^",4),"~",3)'="") D ^PSAPROC4
  1. .E D ASKDRUG
  1. I PSACNT=1 S PSAVAPN=$P($G(^PSDRUG($O(^TMP("PSANDF",$J,0)),"ND")),"^",2) D ONE Q
  1. ;
  1. MANY ;Display for selection if more than 1 drug is found for the Product Name
  1. W !!,"The NDC has the VA Product Name of "_PSAVAPN_".",!,"The following drugs have the same VA Product Name.",!
  1. S (PSACNT,PSAGET,PSAIEN50)=0 F S PSAIEN50=+$O(^TMP("PSANDF",$J,PSAIEN50)) Q:'PSAIEN50 D Q:PSAGET!(+$G(PSAIEN))
  1. .S PSACNT=PSACNT+1,^TMP("PSACNT",$J,PSACNT)=PSAIEN50
  1. .W !?2,PSACNT_". "_^TMP("PSANDF",$J,PSAIEN50)
  1. .I PSACNT#5=0 D Q:PSAGET!($G(PSAIEN))
  1. ..W ! S DIR(0)="N^1:"_PSACNT,DIR("A",1)="Select the received drug or",DIR("A")="enter ""^"" to select the drug from the DRUG file.",DIR("?",1)="Choose the drug you received and assign it to the line item."
  1. ..S DIR("?")="To exit the list and select the drug from the DRUG file, enter ""^"".",DIR("??")="^D SELNDF^PSANDF1" D ^DIR K DIR I $G(DUOUT) S PSAGET=1 Q
  1. ..I $G(DTOUT) S PSAOUT=1 Q
  1. ..I +Y S PSAIEN=^TMP("PSACNT",$J,+Y),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=PSAIEN,$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT
  1. I '$G(PSAIEN),'PSAOUT,PSACNT#5'=0 D G:Y="^" ASKDRUG Q:PSAOUT!($G(PSAIEN))
  1. .W ! S DIR(0)="N^1:"_PSACNT,DIR("A",1)="Select the received drug or",DIR("A")="enter ""^"" to select the drug from the DRUG file."
  1. .S DIR("?")="Select the drug you received or enter ""^"" to select the drug from the DRUG file.",DIR("??")="^D SELNDF^PSANDF1" D ^DIR K DIR Q:Y="^"
  1. .I $G(DTOUT) S PSAOUT=1 Q
  1. .S PSAIEN=^TMP("PSACNT",$J,+Y),$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=PSAIEN,$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSADATA=^(PSALINE) D EDITDISP^PSAUTL1
  1. K ^TMP("PSACNT",$J,PSACNT),^TMP("PSANDF",$J)
  1. Q:+$G(PSAIEN)!(PSAOUT)
  1. I +$P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~",2),$P($P(^(PSALINE),"^",4),"~",3)'="" G ^PSAPROC4
  1. ;
  1. ASKDRUG ;If the NDC found by searching NDF is not correct OR if the NDC can't
  1. ;be found, the user is asked to select the drug.
  1. N PSADRG
  1. W !!,"If the item will never be in the DRUG, press the Return key then",!,"answer YES to the ""Is this a supply item?"" prompt. To bypass this",!,"line item, enter ""^"" then press the Return key.",!
  1. S (PSASKIP,PSAPASS)=0,DIC("A")="Select Drug: ",DIC(0)="AEMZQ",DIC="^PSDRUG("
  1. D ^DIC K DIC I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
  1. S PSAREA="",PSADRG=Y K Y ;; <<*58
  1. I +PSADRG>0 D
  1. .W !!," The selection is: ",$P(PSADRG,U,2)
  1. .K DIR S DIR(0)="Y",DIR("B")="Y",DIR("A")="Is this correct ?" D ^DIR K DIR
  1. .K:'Y PSADRG
  1. I $D(Y),Y<1 G ASKDRUG ;<<*58
  1. I +PSADRG=-1 D Q:PSASUPP Q:PSASKIP
  1. .D SUPPLY Q:PSAOUT
  1. .I 'PSASUPP S PSASKIP=1 Q
  1. .S PSAIEN=0,^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")=DUZ_"^"_DT_"^"_PSAREA,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",18)="P",PSADATA=^(PSALINE)
  1. S PSAIEN=+PSADRG K ^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP") ;*58
  1. S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=+PSADRG,$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT,PSADATA=^(PSALINE) ;*58
  1. D EDITDISP^PSAUTL1
  1. ;
  1. CHECK I $G(PSANDC)'="" D Q
  1. .S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,PSAFND=0
  1. .S PSASUB=0 F S PSASUB=+$O(^PSDRUG(PSAIEN,1,PSASUB)) Q:'PSASUB I $P($G(^PSDRUG(PSAIEN,1,PSASUB,0)),"^")=PSANDC S PSAFND=1 Q
  1. .I PSAFND S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",7)=PSASUB
  1. ;
  1. S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",7)="0~1"
  1. I $P($P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4),"~")="",$P($P(^(PSALINE),"^",26),"~")="" D
  1. .W !,"The vendor did not send a NDC or UPC for the drug. Enter the",!,"NDC if it is available. Enter the UPC if you do not know the NDC.",!
  1. .S DIR(0)="SA^N:NDC;U:UPC",DIR("A")="Will you enter the NDC or UPC? ",DIR("B")="N",DIR("??")="^D NDCUPC^PSANDF1" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
  1. .I Y="N" D GETNDC Q:PSAOUT S PSANDC=Y,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC
  1. .I Y="U" D GETUPC Q:PSAOUT S PSANDC="S"_Y,PSAUPC=Y,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",4)=PSANDC,$P(^(PSALINE),"^",26)=PSAUPC
  1. Q
  1. ;
  1. ONE ;Display for selection if 1 drug is found for that Product Name.
  1. S PSAIEN50=$O(^TMP("PSANDF",$J,0))
  1. W !!,"The NDC has the VA Product Name of "_PSAVAPN_"."
  1. S DIR("A")="Is "_^TMP("PSANDF",$J,PSAIEN50)_" the drug you received",DIR(0)="Y",DIR("B")="N"
  1. S DIR("?",1)="Enter Yes if the drug is the one you received for this line item.",DIR("?")="Enter No if it is not the drug you received.",DIR("??")="^D NDFDRG^PSANDF1"
  1. D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
  1. I +Y S PSAIEN=+PSAIEN50,$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)=PSAIEN,$P(^(PSALINE),"^",16)=DUZ,$P(^(PSALINE),"^",17)=DT K ^TMP("PSANDF",$J) D EDITDISP^PSAUTL1 Q
  1. D ASKDRUG
  1. Q
  1. ;
  1. GETNDC ;Gets NDC for selected drug.
  1. S DIR(0)="F^11,11",DIR("A")="NDC",DIR("?")="Enter the 11-digit National Drug Code. Do not enter dashes",DIR("??")="^D NDC^PSANDF1" ;*58
  1. D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
  1. I Y'?11N W !,"You must enter exactly eleven numbers." G GETNDC ;*58
  1. Q
  1. GETUPC ;Gets UPC for selected drug.
  1. S DIR(0)="F^1:30",DIR("A")="UPC",DIR("?")="Enter the Universal Product Code",DIR("??")="^D UPC^PSANDF1"
  1. D ^DIR K DIR I $G(DIRUT) S PSAOUT=1 Q
  1. Q
  1. SUPPLY ;Asks if item is a supply. If so, asks for supply info.
  1. S DIR(0)="Y",DIR("A")="Is this a supply item",DIR("?")="Enter YES if the item is not and will never be in the DRUG file",DIR("??")="^D SUP^PSANDF1" D ^DIR K DIR S PSASUPP=Y Q:$G(DIRUT)
  1. I 'PSASUPP S PSAPASS=1 Q
  1. W ! S DIR(0)="F^3:30",DIR("A",1)="Enter either a description of the item or",DIR("A")="the reason why the item is not in the DRUG file"
  1. S DIR("?",1)="If the item is a supply, enter the name of the supply",DIR("?")="or a reason why this item is not in the DRUG file.",DIR("??")="^D REA^PSANDF1" D ^DIR K DIR S PSAREA=Y I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1
  1. S:PSAREA="" PSAREA="SUPPLY ITEM"
  1. Q:$G(PSAVER)
  1. S $P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE),"^",15)="",$P(^(PSALINE),"^",16)="",$P(^(PSALINE),"^",17)=""
  1. Q