| [613] | 1 | PSNCMOP ;BIR/DMA&WRT-print products marked for CMOP ; 12/07/98 14:33
|
|---|
| 2 | ;;4.0; NATIONAL DRUG FILE;**3**; 30 Oct 98
|
|---|
| 3 | PRELIM W !,"This report will print out all VA Product Names marked for CMOP transmission.",!,"You may either sort by VA Product Name or by VA Identifier.",!
|
|---|
| 4 | W "This information comes from the VA Products file (NATIONALLY MARKED).",!,?15,"*** This is a long report ***",!,"You may queue the report to print, if you wish.",!!
|
|---|
| 5 | K DIR S DIR(0)="SA^I:IDENTIFIER;N:NAME",DIR("A")="Sort by VA Identifier (I) or VA Product Name (N)? " D ^DIR G END:$D(DIRUT) S S=Y
|
|---|
| 6 | S ZTSAVE("S")="" D EN^XUTMDEVQ("GO^PSNCMOP","PRINT DRUGS MARKED FOR CMOP",.ZTSAVE) I POP W !,"No device selected",!
|
|---|
| 7 | END K DIR,S,X,Y,ZTSAVE,^TMP($J,"PSN") Q
|
|---|
| 8 | ;
|
|---|
| 9 | GO ;ENTRY POINT
|
|---|
| 10 | K ^TMP($J,"PSN") D @S
|
|---|
| 11 | S:$D(ZTQUEUED) ZTREQ="@" K DA,DIR,ID,LINE,NA,PG,PR,S,TD,UN,X0,X1,Y,^TMP($J) D ^%ZISC Q
|
|---|
| 12 | ;
|
|---|
| 13 | I ;SORT BY ID
|
|---|
| 14 | S DA=0 F S DA=$O(^PSNDF(50.68,DA)) Q:'DA S X0=^(DA,0),X1=^(1) I $P(X1,"^",3) S ID=$P(X1,"^",2),NA=$P(X0,"^",1),UN=$P(X1,"^",4),UN=$P($G(^PSNDF(50.64,+UN,0)),"^"),^TMP($J,"PSN",ID,NA,UN)=""
|
|---|
| 15 | S PG=1,TD=$TR($$HTE^XLFDT($H),"@"," "),$P(LINE,"-",IOM-1)="" D HEADID
|
|---|
| 16 | S ID="" F S ID=$O(^TMP($J,"PSN",ID)),NA="" Q:ID="" F S NA=$O(^TMP($J,"PSN",ID,NA)),UN="" Q:NA="" F S UN=$O(^TMP($J,"PSN",ID,NA,UN)) Q:UN="" W !,ID,?10,NA,?60,UN I $Y+4>IOSL D HEADID
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | HEADID W:$Y @IOF W !,?12,"VA PRODUCT LIST",?IOM-35," ",TD," PAGE ",PG,!,"ID#",?10,"VA PRINT NAME",?55,"VA DISP UNIT",!,LINE,! S PG=PG+1 Q
|
|---|
| 20 | ;
|
|---|
| 21 | ;
|
|---|
| 22 | N ;SORT BY NAME
|
|---|
| 23 | S DA=0 F S DA=$O(^PSNDF(50.68,DA)) Q:'DA S X0=^(DA,0),X1=^(1) I $P(X1,"^",3)]"" S NA=$P(X0,"^"),PR=$P(X1,"^"),UN=$P(X1,"^",4),UN=$P($G(^PSNDF(50.64,+UN,0)),"^"),ID=$P(X1,"^",2),^TMP($J,"PSN",NA,PR,UN,ID)=""
|
|---|
| 24 | S PG=1,TD=$TR($$HTE^XLFDT($H),"@"," "),$P(LINE,"-",IOM-1)="" D HEADNA
|
|---|
| 25 | S NA="" F S NA=$O(^TMP($J,"PSN",NA)),PR="" Q:NA="" F S PR=$O(^TMP($J,"PSN",NA,PR)),UN="" Q:PR="" F S UN=$O(^TMP($J,"PSN",NA,PR,UN)),ID="" Q:UN="" F S ID=$O(^TMP($J,"PSN",NA,PR,UN,ID)) Q:ID="" D
|
|---|
| 26 | .W !,NA,!,?7,PR,?60,UN,?70,ID I $Y+4>IOSL D HEADNA
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | HEADNA W:$Y @IOF W !,?12,"VA PRODUCT LIST",?IOM-35," ",TD," PAGE ",PG,!,"VA PRODUCT NAME",!,?5,"VA PRINT NAME",?55,"VA DISP UNIT",?70,"ID#",!,LINE,! S PG=PG+1 Q
|
|---|
