PSXDENT.m

PSXDENT ;BIR/WRT-Set Xref for ID ;[ 10/19/98  7:13 AM ]

 ;;2.0;CMOP;**18,19**;11 Apr 97

 D START K PSXB,PSXID,PSXNDF,PSXVAPN

 Q

START F PSXB=0:0 S PSXB=$O(^PSDRUG("AQ",PSXB)) Q:'PSXB  I $P(^PSDRUG(PSXB,3),"^",1)=1 S PSXNDF=$P(^PSDRUG(PSXB,"ND"),"^",1),PSXVAPN=$P(^PSDRUG(PSXB,"ND"),"^",3),ZX=$$PROD2^PSNAPIS(PSXNDF,PSXVAPN),PSXID=$P($G(ZX),"^",2) K ZX D SETT

 Q

SETT S $P(^PSDRUG(PSXB,"ND"),"^",10)=PSXID,^PSDRUG("AQ1",PSXID,PSXB)=""

 Q

PSXDENT   ;BIR/WRT-Set Xref for ID ;[ 10/19/98  7:13 AM ]

 +1       ;;2.0;CMOP;**18,19**;11 Apr 97

 +2        DO START

           KILL PSXB,PSXID,PSXNDF,PSXVAPN

 +3        QUIT 

START      FOR PSXB=0:0

               SET PSXB=$ORDER(^PSDRUG("AQ",PSXB))

               IF 'PSXB

                   QUIT 

               IF $PIECE(^PSDRUG(PSXB,3),"^",1)=1

                   SET PSXNDF=$PIECE(^PSDRUG(PSXB,"ND"),"^",1)

                   SET PSXVAPN=$PIECE(^PSDRUG(PSXB,"ND"),"^",3)

                   SET ZX=$$PROD2^PSNAPIS(PSXNDF,PSXVAPN)

                   SET PSXID=$PIECE($GET(ZX),"^",2)

                   KILL ZX

                   DO SETT

 +1        QUIT 

SETT       SET $PIECE(^PSDRUG(PSXB,"ND"),"^",10)=PSXID

           SET ^PSDRUG("AQ1",PSXID,PSXB)=""

 +1        QUIT