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

PSAGIP1.m

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