| 1 | PSAPOST ;BIR/JMB-Post Init ;7/23/97
|
|---|
| 2 | ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**64**; 10/24/97;Build 4
|
|---|
| 3 | ;If there is a NDC in field #31, the NDC is added to the SYNONYM
|
|---|
| 4 | ;multiple.
|
|---|
| 5 | ;
|
|---|
| 6 | SYNONYM D BMES^XPDUTL("Copying the NDCs to the SYNONYM multiple in the DRUG file.")
|
|---|
| 7 | S PSAIEN=0 F S PSAIEN=$O(^PSDRUG(PSAIEN)) Q:'PSAIEN D
|
|---|
| 8 | .Q:$P($G(^PSDRUG(PSAIEN,2)),"^",4)=""
|
|---|
| 9 | .S PSANDC4=$P($G(^PSDRUG(PSAIEN,2)),"^",4)
|
|---|
| 10 | .S PSANDC=$E("000000",1,(6-$L($P(PSANDC4,"-"))))_$P(PSANDC4,"-")_$E("0000",1,(4-$L($P(PSANDC4,"-",2))))_$P(PSANDC4,"-",2)_$E("00",1,(2-$L($P(PSANDC4,"-",3))))_$P(PSANDC4,"-",3)
|
|---|
| 11 | .S PSADASH=$E("000000",1,(6-$L($P(PSANDC4,"-"))))_$P(PSANDC4,"-")_"-"_$E("0000",1,(4-$L($P(PSANDC4,"-",2))))_$P(PSANDC4,"-",2)_"-"_$E("00",1,(2-$L($P(PSANDC4,"-",3))))_$P(PSANDC4,"-",3)
|
|---|
| 12 | .I '$D(^PSDRUG(PSAIEN,1,0)) S ^PSDRUG(PSAIEN,1,0)="^50.1A^^"
|
|---|
| 13 | .K DD,DO,DA S DA(1)=PSAIEN,DIC="^PSDRUG("_DA(1)_",1,",DIC(0)="LM",X=PSANDC,DLAYGO=50 D ^DIC K DIC,DLAYGO
|
|---|
| 14 | .Q:$G(DA)=""
|
|---|
| 15 | .S DR="2///"_PSADASH_";1///D",DA=+Y,DIE="^PSDRUG("_DA(1)_",1,"
|
|---|
| 16 | .F L +^PSDRUG(PSAIEN,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I Q
|
|---|
| 17 | .D ^DIE K DIE L -^PSDRUG(PSAIEN,0)
|
|---|
| 18 | K DA,DIC,DIE,DR,PSADASH,PSAIEN,PSANDC,PSANDC4,X,Y
|
|---|
| 19 | D BMES^XPDUTL("Copying NDCs is complete!")
|
|---|
| 20 | Q
|
|---|
