PSAGIP1 ;BIR/LTL,JMB-DA receiving from GIP - CONT'D;7/23/97
 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**8**; 10/24/97
 N PSACOS,PSACO,PSACOD,PSAPC1,PSAPC2,PSAPC3,PSAFND,PSAONDC,PSAQT,PSAC,DA,DIE,DR,XMDUZ,XMSUB,XMY,XMTEXT
 G:'PSACOST!('PSAQTY) NDC
 S PSACOS=+$J((PSACOST/PSAQTY),0,3)
 S PSACO=$G(^PSDRUG(+PSADRUG,660))
 G:PSACOS=+$P(PSACO,U,6)!('$P(PSACO,U,5)) NDC
 S PSAQT=$P($G(^PSD(58.8,+PSALOC,1,+PSADRUG,0)),U,4)
 I PSAQT>0 S PSACOST=PSACOST+(PSAQT*+$P(PSACO,U,6)),PSAQT=PSAQTY+PSAQT,PSACOS=+$J((PSACOST/PSAQT),0,3)
 G:PSACOS=+$P(PSACO,U,6) NDC
 S PSAC=+$J((PSACOS*$P(PSACO,U,5)),0,2)
 S DIE="^PSDRUG(",DA=PSADRUG
 S PSAFND=0,PSAONDC=$P($G(^PSDRUG(PSADRUG,2)),"^",4)
 D:PSANDC'=PSAONDC&(PSANDC'="")
 .S PSAPC1=$L($P(PSANDC,"-")),PSAPC2=$L($P(PSANDC,"-",2)),PSAPC3=$L($P(PSANDC,"-",3))
 .I PSAPC1=4,PSAPC2=4,PSAPC3=2 S PSAFND=1 Q
 .I PSAPC1=5,PSAPC2=3,PSAPC3=2 S PSAFND=1 Q
 .I PSAPC1=5,PSAPC2=4,PSAPC3=1 S PSAFND=1 Q
 .I PSAPC1=5,PSAPC2=4,PSAPC3=2 S PSAFND=1 Q
 .I PSAPC1=6,PSAPC2=4,PSAPC3=2 S PSAFND=1
 S DR=$S(PSAFND:"13////"_PSAC_";31////"_PSANDC,1:"13////"_PSAC) D ^DIE K DIE,DA
 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
 I PSANDC'=PSAONDC,PSANDC'="" D
 .S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25),1)="   Old NDC: "_$S(PSAONDC'="":PSAONDC,1:"None")_", New NDC: "_PSANDC
 .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."
END Q:$O(^TMP("PSA",$J,PSADRUG))
 N PSAMSG S PSAMSG=$O(^TMP("PSAD",$J,"")) Q:PSAMSG=""
 N PSADRG S PSACNT=1,PSADRG=""
 F  S PSADRG=$O(^TMP("PSAD",$J,PSADRG)) Q:PSADRG=""  D
 .S ^TMP("PSAMSG",$J,PSACNT)=^TMP("PSAD",$J,PSADRG),PSACNT=PSACNT+1
 .S:$D(^TMP("PSAD",$J,PSADRG,1)) ^TMP("PSAMSG",$J,PSACNT)=^TMP("PSAD",$J,PSADRG,1),PSACNT=PSACNT+1
 .S:$D(^TMP("PSAD",$J,PSADRG,2)) ^TMP("PSAMSG",$J,PSACNT)=^TMP("PSAD",$J,PSADRG,2),PSACNT=PSACNT+1
 S XMDUZ="Price & NDC Updater",XMSUB="DRUG file Price/NDC Update - "_PSAP
 S XMY(DUZ)="",XMTEXT="^TMP(""PSAMSG"",$J,"
 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
 G:'$D(XMY) QUIT D ^XMD
QUIT K ^TMP("PSAD",$J),^TMP("PSAMSG",$J)
 Q
NDC ;This is called if the cost has not changed.
 S PSAFND=0,PSAONDC=$P($G(^PSDRUG(PSADRUG,2)),"^",4)
 G:PSANDC=PSAONDC!(PSANDC="") END
 D:PSANDC'=""
 .S PSAPC1=$L($P(PSANDC,"-")),PSAPC2=$L($P(PSANDC,"-",2)),PSAPC3=$L($P(PSANDC,"-",3))
 .I PSAPC1=4,PSAPC2=4,PSAPC3=2 S PSAFND=1
 .I PSAPC1=5,PSAPC2=3,PSAPC3=2 S PSAFND=1
 .I PSAPC1=5,PSAPC2=4,PSAPC3=1 S PSAFND=1
 .I PSAPC1=5,PSAPC2=4,PSAPC3=2 S PSAFND=1
 .I PSAPC1=6,PSAPC2=4,PSAPC3=2 S PSAFND=1
 .I PSAFND S DIE="^PSDRUG(",DA=PSADRUG,DR=";31////^S X=PSANDC" D ^DIE K DIE,DA
 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)
 S ^TMP("PSAD",$J,$E($P($G(^PSDRUG(+PSADRUG,0)),U),1,25),1)="   Old NDC: "_$S(PSAONDC'="":PSAONDC,1:"None")_", New NDC: "_PSANDC
 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."
 G END