source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAGIP1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1PSAGIP1 ;BIR/LTL,JMB-DA receiving from GIP - CONT'D;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**8**; 10/24/97
3 N PSACOS,PSACO,PSACOD,PSAPC1,PSAPC2,PSAPC3,PSAFND,PSAONDC,PSAQT,PSAC,DA,DIE,DR,XMDUZ,XMSUB,XMY,XMTEXT
4 G:'PSACOST!('PSAQTY) NDC
5 S PSACOS=+$J((PSACOST/PSAQTY),0,3)
6 S PSACO=$G(^PSDRUG(+PSADRUG,660))
7 G:PSACOS=+$P(PSACO,U,6)!('$P(PSACO,U,5)) NDC
8 S PSAQT=$P($G(^PSD(58.8,+PSALOC,1,+PSADRUG,0)),U,4)
9 I PSAQT>0 S PSACOST=PSACOST+(PSAQT*+$P(PSACO,U,6)),PSAQT=PSAQTY+PSAQT,PSACOS=+$J((PSACOST/PSAQT),0,3)
10 G:PSACOS=+$P(PSACO,U,6) NDC
11 S PSAC=+$J((PSACOS*$P(PSACO,U,5)),0,2)
12 S DIE="^PSDRUG(",DA=PSADRUG
13 S PSAFND=0,PSAONDC=$P($G(^PSDRUG(PSADRUG,2)),"^",4)
14 D:PSANDC'=PSAONDC&(PSANDC'="")
15 .S PSAPC1=$L($P(PSANDC,"-")),PSAPC2=$L($P(PSANDC,"-",2)),PSAPC3=$L($P(PSANDC,"-",3))
16 .I PSAPC1=4,PSAPC2=4,PSAPC3=2 S PSAFND=1 Q
17 .I PSAPC1=5,PSAPC2=3,PSAPC3=2 S PSAFND=1 Q
18 .I PSAPC1=5,PSAPC2=4,PSAPC3=1 S PSAFND=1 Q
19 .I PSAPC1=5,PSAPC2=4,PSAPC3=2 S PSAFND=1 Q
20 .I PSAPC1=6,PSAPC2=4,PSAPC3=2 S PSAFND=1
21 S DR=$S(PSAFND:"13////"_PSAC_";31////"_PSANDC,1:"13////"_PSAC) D ^DIE K DIE,DA
22 S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25))=$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25)_", Item #"_$P($G(^TMP("PSA",$J,PSADRUG)),U,6)_", Old price: $"_$P(PSACO,U,6)_", New price: $"_PSACOS
23 I PSANDC'=PSAONDC,PSANDC'="" D
24 .S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25),1)=" Old NDC: "_$S(PSAONDC'="":PSAONDC,1:"None")_", New NDC: "_PSANDC
25 .I 'PSAFND S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25),2)=" The new NDC was not entered in the DRUG file due to an invalid format."
26END Q:$O(^TMP("PSA",$J,PSADRUG))
27 N PSAMSG S PSAMSG=$O(^TMP("PSAD",$J,"")) Q:PSAMSG=""
28 N PSADRG S PSACNT=1,PSADRG=""
29 F S PSADRG=$O(^TMP("PSAD",$J,PSADRG)) Q:PSADRG="" D
30 .S ^TMP("PSAMSG",$J,PSACNT)=^TMP("PSAD",$J,PSADRG),PSACNT=PSACNT+1
31 .S:$D(^TMP("PSAD",$J,PSADRG,1)) ^TMP("PSAMSG",$J,PSACNT)=^TMP("PSAD",$J,PSADRG,1),PSACNT=PSACNT+1
32 .S:$D(^TMP("PSAD",$J,PSADRG,2)) ^TMP("PSAMSG",$J,PSACNT)=^TMP("PSAD",$J,PSADRG,2),PSACNT=PSACNT+1
33 S XMDUZ="Price & NDC Updater",XMSUB="DRUG file Price/NDC Update - "_PSAP
34 S XMY(DUZ)="",XMTEXT="^TMP(""PSAMSG"",$J,"
35 I $P($G(^PSD(58.8,+PSALOC,4,+$G(PSAGIP),0)),U,3)'="" S XX=$P(^(0),"^",3),XXX="G."_XX,XMY(XXX)="" K XX,XXX
36 G:'$D(XMY) QUIT D ^XMD
37QUIT K ^TMP("PSAD",$J),^TMP("PSAMSG",$J)
38 Q
39NDC ;This is called if the cost has not changed.
40 S PSAFND=0,PSAONDC=$P($G(^PSDRUG(PSADRUG,2)),"^",4)
41 G:PSANDC=PSAONDC!(PSANDC="") END
42 D:PSANDC'=""
43 .S PSAPC1=$L($P(PSANDC,"-")),PSAPC2=$L($P(PSANDC,"-",2)),PSAPC3=$L($P(PSANDC,"-",3))
44 .I PSAPC1=4,PSAPC2=4,PSAPC3=2 S PSAFND=1
45 .I PSAPC1=5,PSAPC2=3,PSAPC3=2 S PSAFND=1
46 .I PSAPC1=5,PSAPC2=4,PSAPC3=1 S PSAFND=1
47 .I PSAPC1=5,PSAPC2=4,PSAPC3=2 S PSAFND=1
48 .I PSAPC1=6,PSAPC2=4,PSAPC3=2 S PSAFND=1
49 .I PSAFND S DIE="^PSDRUG(",DA=PSADRUG,DR=";31////^S X=PSANDC" D ^DIE K DIE,DA
50 S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25))=$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25)_", Item #"_$P($G(^TMP("PSA",$J,PSADRUG)),U,6)
51 S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25),1)=" Old NDC: "_$S(PSAONDC'="":PSAONDC,1:"None")_", New NDC: "_PSANDC
52 I 'PSAFND S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25),2)=" The new NDC was not entered in the DRUG file due to an invalid format."
53 G END
Note: See TracBrowser for help on using the repository browser.