| [613] | 1 | PSNPSS ;BIR/WRT-kills off orderable item ; 04/18/01 14:58
|
|---|
| 2 | ;;4.0; NATIONAL DRUG FILE;**33,51**; 30 Oct 98
|
|---|
| 3 | ;References to ^PSDRUG supported by DBIAs #221 and #2352
|
|---|
| 4 | ;Reference to ^PS(50.606 supported by DBIA #2174
|
|---|
| 5 | ;Reference to ^PS(50.7 supported by DBIA #2180
|
|---|
| 6 | ;Reference to ^PS(52.6 supported by DBIA #1231
|
|---|
| 7 | ;Reference to ^PS(52.7 supported by DBIA #2173
|
|---|
| 8 | BEGIN D DISP,SOL,ADD K ADDITM,BBC,DA,DFM,DIE,DOS,IVDF,IVDFPTR,OIDF,PSNOI,SOLITM,ADDNM,K,X,SOLNM
|
|---|
| 9 | Q
|
|---|
| 10 | DISP S X=$$PSJDF^PSNAPIS(DA,K) I X]"" S DFM=$P(X,"^") I $D(^PSDRUG(PSNB,2)),$P(^PSDRUG(PSNB,2),"^",1)]"" S PSNOI=$P(^PSDRUG(PSNB,2),"^",1),OIDF=$P(^PS(50.7,PSNOI,0),"^",2) I DFM'=OIDF D KILLOI
|
|---|
| 11 | Q
|
|---|
| 12 | KILLOI S ^TMP("PSNDP",$J,$P(^PSDRUG(PSNB,0),"^",1))="",DA=PSNB,DIE="^PSDRUG(",DR="2.1///"_"@" D ^DIE
|
|---|
| 13 | Q
|
|---|
| 14 | SOL I $D(^PS(52.7,"AC",PSNB)) F BBC=0:0 S BBC=$O(^PS(52.7,"AC",PSNB,BBC)) Q:'BBC S SOLITM=$P(^PS(52.7,BBC,0),"^",11) I SOLITM]"" I $D(^PS(52.7,"AOI",SOLITM,BBC)) D SOLCK
|
|---|
| 15 | Q
|
|---|
| 16 | SOLCK S IVDFPTR=$P(^PS(50.7,SOLITM,0),"^",2),IVDF=$P(^PS(50.606,IVDFPTR,0),"^",1) I IVDF'=DFM,$P(^PS(52.7,BBC,0),"^",11)]"" S SOLNM=$P(^PS(52.7,BBC,0),"^",1),^TMP("PSNSL",$J,SOLNM)="" S DA=BBC,DIE="^PS(52.7,",DR="9///"_"@" D ^DIE
|
|---|
| 17 | Q
|
|---|
| 18 | ADD I $D(^PS(52.6,"AC",PSNB)) F BBC=0:0 S BBC=$O(^PS(52.6,"AC",PSNB,BBC)) Q:'BBC S ADDITM=$P(^PS(52.6,BBC,0),"^",11) I ADDITM]"" I $D(^PS(52.6,"AOI",ADDITM,BBC)) D ADDCK
|
|---|
| 19 | Q
|
|---|
| 20 | ADDCK S IVDFPTR=$P(^PS(50.7,ADDITM,0),"^",2),IVDF=$P(^PS(50.606,IVDFPTR,0),"^",1) I IVDF'=DFM,$P(^PS(52.6,BBC,0),"^",11)]"" S ADDNM=$P(^PS(52.6,BBC,0),"^",1),^TMP("PSNAD",$J,ADDNM)="" S DA=BBC,DIE="^PS(52.6,",DR="15///"_"@" D ^DIE
|
|---|
| 21 | Q
|
|---|
