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

PSNCLPR.m

Go to the documentation of this file.
  1. PSNCLPR ;BIR/DMA&WRT-print products sorted by class ; 11/22/98 15:10
  1. ;;4.0; NATIONAL DRUG FILE;**3**; 30 Oct 98
  1. PRELIM W !,"This report will print out all VA Product Names by VA Drug Class. You may",!,"sort by Primary, Secondary, or Both Classes. This information comes from",!,"the VA Products file.",!
  1. W "You may queue the report to print, if you wish.",!! D DISC
  1. K DIR S DIR(0)="SA^P:PRIMARY;S:SECONDARY;B:BOTH",DIR("A")="Sort by Primary (P), Secondary (S), or Both (B) Classes? " D ^DIR G END:$D(DIRUT) S S=Y
  1. S ZTSAVE("S")="" D EN^XUTMDEVQ("GO^PSNCLPR","PRINT DRUGS SORTED BY CLASS",.ZTSAVE) I POP W !,"No device selected",!
  1. END K DIR,S,X,Y,ZTSAVE,^TMP($J,"PSN"),CL,DA,K,LINE,NA,TD,DIR Q
  1. ;
  1. GO ;ENTRY POINT
  1. K ^TMP($J,"PSN")
  1. S DA=0 F S DA=$O(^PSNDF(50.68,DA)) Q:'DA S NA=$P(^(DA,0),"^") D
  1. .I S'="S" S CL=$P($G(^PSNDF(50.68,DA,3)),"^"),CL=$P(^PS(50.605,+CL,0),"^"),^TMP($J,"PSN",CL,NA)=""
  1. .I S'="P" S K=0 F S K=$O(^PSNDF(DA,4,K,0)) Q:'K S CL=$P($G(^PS(50.605,K,0)),"^")_$S(S="B":"*",1:""),^TMP($J,"PSN",CL,NA)=""
  1. ;
  1. S PG=1,TD=$TR($$HTE^XLFDT($H),"@"," "),$P(LINE,"-",IOM-1)=""
  1. D HEAD S CL="" F S CL=$O(^TMP($J,"PSN",CL)),NA="" Q:CL="" F S NA=$O(^TMP($J,"PSN",CL,NA)) Q:NA="" W !,CL,?S="B"*8+10,NA I $Y+4>IOSL D HEAD
  1. K CL,DA,K,LINE,NA,S,TD S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC Q
  1. ;
  1. DISC W !!,"***DISCLAIMER: The Secondary VA Drug Class field has not been populated",!,"with data at this time. No report will be generated if sort by Secondary (S)",!,"is chosen. Currently, sorting"
  1. W " by Primary (P) VA Drug Class is the same as",!,"sorting by both classes. This disclaimer will be removed once the field is",!,"populated with data.",!! Q