source: FOIAVistA/tag/r/DRUG_ACCOUNTABILITY-PSA/PSATI.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1PSATI ;BIR/LTL-Single Drug Match ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**8,18,23,21**; 10/24/97
3 ;This routine enters/edits links with the ITEM MASTER file.
4 ;
5 ;References to $$DESCR^PRCPUX1 are covered by IA #259
6 ;References to $$VENNAME^PRCPUX1 are covered by IA #259
7 ;References to ^PRC( are covered by IA #214
8 ;References to ^PSDRUG( are covered by IA #2095
9 ;
10 N PSAIT,DTOUT,DUOUT,DIE,D0,D1,DA,DIC,DIR,DLAYGO,DR,DIRUT
11START D DT^DICRW
12 ;For call by ^PSAENT & ^PSAUNL
13 I $G(PSAIT) S DIC(0)="Q",X=PSAIT W !!,$P($G(^PSDRUG(+PSAIT,0)),U),!!
14 ;LOOK UP DRUG
15LOOK S:'$D(DIC(0)) DIC(0)="AEMQ" S DIC=50,DIC("S")="I $S('$D(^(""I"")):1,+^(""I"")>DT:1,1:0)" D ^DIC K DIC G:$D(DTOUT)!($D(DUOUT))!(Y<0) QUIT S (PSADRUG,PSAIT)=$P(Y,U)
16DIS I $O(^PSDRUG(+PSADRUG,441,0)) W !,"This drug is currently linked to the following item(s):",!! S PSAIM=0 F S PSAIM=$O(^PSDRUG(PSADRUG,441,PSAIM)) Q:PSAIM="B" S PSAI=$P(^PSDRUG(PSADRUG,441,PSAIM,0),U) D:$$DESCR^PRCPUX1(0,PSAI)]""
17 .W !,PSAI_" "_$$DESCR^PRCPUX1(0,PSAI)_" ",$$VENNAME^PRCPUX1($P($G(^PRC(441,+PSAI,0)),U,4)_"PRC(440"),!
18QUES1 I $D(PSAI) S DIR(0)="Y",DIR("A")="Would you like to alter the link(s)",DIR("B")="No" D ^DIR K DIR G:Y<1&('$D(PSALOC)) AGAIN G:Y<1 QUIT
19 W !!,"Current potential ITEM MASTER file links based on NDC or FSN are:",!!
20 ;Attempt match by NDC between #50/#441
21NDC I $P($G(^PSDRUG(PSADRUG,2)),U,4)]"" S PSANDC=$P(^(2),U,4),PSAI=$$ITEM^PSAUTL(PSANDC) W "DRUG file NDC: "_PSANDC
22 I $D(PSAI),$D(PSANDC),PSAI W ?40,"ITEM NUMBER: "_PSAI,!!,"DESC: "_$$DESCR^PRCPUX1(0,PSAI),! W:$G(^PRC(441,+PSAI,3)) !?60,"* Inactive item" D:$O(^PRC(441,"F",PSANDC,PSAI))
23MORE .S PSAZ=1,PSAI(PSAZ)=PSAI F S PSAI(PSAZ)=$O(^PRC(441,"F",PSANDC,PSAI(PSAZ))) Q:PSAI(PSAZ)="" W !?40,"ITEM NUMBER: "_PSAI(PSAZ),!!,"DESC: ",$$DESCR^PRCPUX1(0,PSAI(PSAZ)) W:$G(^PRC(441,+PSAI(PSAZ),3)) !?60,"* Inactive item"
24 ;Attempt match between FSN (#50) and NSN (#441)
25FSN I '$G(PSAI),$P(^PSDRUG(PSADRUG,0),U,6)]"" S PSAFSN=$P(^(0),U,6) D:$D(^PRC(441,"BB",PSAFSN))
26 .S PSAI=$O(^PRC(441,"BB",PSAFSN,"")) W " NO NDC MATCH IN ITEM MASTER file.",!!,"DRUG file FSN: "_PSAFSN,?40,"ITEM NUMBER: "_PSAI,!!,"DESC: ",$$DESCR^PRCPUX1(0,PSAI),!
27FAIL S:'$D(PSAI) PSAI="" W:PSAI']"" !!,"No NDC or FSN match in the ITEM MASTER file.",!
28 ;S:'$D(^PSDRUG(+PSADRUG,441,0)) ^(0)="^50.0441P^^" ;Removed by SQA recommendation (PSA*3*18)
29CON S DIE="^PSDRUG(",DA=PSADRUG,DR="441//^S X=$G(PSAI)" D ^DIE K DIE I $D(Y)!($D(DTOUT)) S DIRUT=1 G QUIT
30 I '$D(^PSDRUG(PSADRUG,"ND")) W !!,"No NDF link, can't help.",! G AGAIN
31 I $P(^PSDRUG(PSADRUG,"ND"),U)']"" W !!,"No NDF link, can't help.",! K DUOUT G AGAIN
32 ;Check for package size or type = OTHER
33 I $P($G(^PSDRUG(+PSADRUG,"ND")),U,4)=2058 W !!,"No matching PACKAGE SIZE in the National Drug File." G AGAIN
34 I $P($G(^PSDRUG(+PSADRUG,"ND")),U,5)=623 W !!,"No matching PACKAGE TYPE in the National Drug file." G AGAIN
35NDF ;Offer NDF path
36 W !!,"This drug is linked to the NATIONAL DRUG file.",!!,"There may be an NDC there that will link to the ITEM MASTER file.",!
37 S DIR(0)="Y",DIR("A")="Would you like to check",DIR("B")="No" D ^DIR K DIR G:$D(DIRUT)!(Y<1) AGAIN
38 ;
39 ;DAVE B (PSA*3*18) Old NDF globals no longer used.
40 S PSAVP=$P($G(^PSDRUG(PSADRUG,"ND")),"^",3) I $G(PSAVP)="" W !,"Sorry, there is no entry in the PSNDF VA PRODUCT NAME, cannot find match.",! G AGAIN
41 ;Call PSNAPIS
42 S X=$$CIRN2^PSNAPIS("",PSAVP,.PSANDF)
43 S PSX="" F S PSX=$O(PSANDF(PSX)) Q:PSX="" K PSA D Q:Y<1 D BINGO
44 .I PSX'["-" S PSAOLD=$G(PSANDC),PSANDC=PSX D PSANDC1^PSAHELP S PSA=PSANDCX K PSANDCX I $G(PSAOLD)'="" S PSANDC=PSAOLD K PSAOLD
45 .I $G(PSA)="" S PSA=PSX
46 .W !,"Going to check NDC #"_PSA,! S DIR(0)="Y",DIR("A")="OK",DIR("B")="No" D ^DIR K DIR Q:$D(DIRUT)!(Y<1)
47AGAIN K PSA,PSAD,PSADO,PSADRUG,PSAF,PSAFSN,PSANDC,PSANDF,PSAI,PSAIM,PSAIQ,PSAIQT,PSAIAC,PSAILC,PSAINV,PSAINVN,PSAP,PSAPB,PSAS,PSAT,PSATB,PSAU,PSAV,PSAZ,X,Y
48 Q:$D(PSAS)!($D(PSALOC)) W ! S DIR(0)="Y",DIR("A")="Another drug",DIR("B")="Yes" D ^DIR K DIR I Y>0 K PSAIT,PSAI G START
49QUIT N:'$G(PSAIT(1)) PSAIT,Y K PSA,PSAI,PSAD,PSADO,PSADRUG,PSAF,PSAFSN,PSANDC,PSANDF,PSAI,PSAIM,PSAIQ,PSAIQT,PSAIAC,PSAILC,PSAINV,PSAINVN,PSAP,PSAPB,PSAS,PSAT,PSATB,PSAU,PSAV,PSAZ,X,Y Q
50BINGO S PSAI=$O(^PRC(441,"F",PSA,""))
51 Q:$O(^PSDRUG("AB",+PSAI,0))
52 W !!,"DRUG file: "_$P(^PSDRUG(PSADRUG,0),U),!!,"Item #: "_PSAI," Desc: ",$$DESCR^PRCPUX1(0,PSAI),! D
53 .S DIR(0)="Y",DIR("A")="OK to link",DIR("B")="Yes",DIR("?")="If yes, I'll perform the link" D ^DIR K DIR K:(Y=0) Y Q:($G(Y)<1)
54 .S DIE=50,DA=PSADRUG,DR="441///^S X=""`""_PSAI" D ^DIE W " linked."
55 Q
Note: See TracBrowser for help on using the repository browser.