PSNCLPR ;BIR/DMA&WRT-print products sorted by class ; 11/22/98 15:10
;;4.0; NATIONAL DRUG FILE;**3**; 30 Oct 98
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.",!
W "You may queue the report to print, if you wish.",!! D DISC
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
S ZTSAVE("S")="" D EN^XUTMDEVQ("GO^PSNCLPR","PRINT DRUGS SORTED BY CLASS",.ZTSAVE) I POP W !,"No device selected",!
END K DIR,S,X,Y,ZTSAVE,^TMP($J,"PSN"),CL,DA,K,LINE,NA,TD,DIR Q
;
GO ;ENTRY POINT
K ^TMP($J,"PSN")
S DA=0 F S DA=$O(^PSNDF(50.68,DA)) Q:'DA S NA=$P(^(DA,0),"^") D
.I S'="S" S CL=$P($G(^PSNDF(50.68,DA,3)),"^"),CL=$P(^PS(50.605,+CL,0),"^"),^TMP($J,"PSN",CL,NA)=""
.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)=""
;
S PG=1,TD=$TR($$HTE^XLFDT($H),"@"," "),$P(LINE,"-",IOM-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
K CL,DA,K,LINE,NA,S,TD S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC Q
;
HEAD W:$Y @IOF W !,"VA PRODUCT LIST",?IOM-35," ",TD," PAGE ",PG,!! W:S="P" "PRIMARY",! W:S="S" "SECONDARY",! W:S="B" "PRIMARY OR",!,"SECONDARY",!,"VA CLASS CODE" W:S'="B" "VA CLASS",!,"CODE" W ?S="B"*10+12,"VA PRODUCT NAME",!,LINE,! S PG=PG+1 Q
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"
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNCLPR 1923 printed Sep 23, 2025@19:59:48 Page 2
PSNCLPR ;BIR/DMA&WRT-print products sorted by class ; 11/22/98 15:10
+1 ;;4.0; NATIONAL DRUG FILE;**3**; 30 Oct 98
PRELIM WRITE !,"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 WRITE "You may queue the report to print, if you wish.",!!
DO DISC
+2 KILL DIR
SET DIR(0)="SA^P:PRIMARY;S:SECONDARY;B:BOTH"
SET DIR("A")="Sort by Primary (P), Secondary (S), or Both (B) Classes? "
DO ^DIR
if $DATA(DIRUT)
GOTO END
SET S=Y
+3 SET ZTSAVE("S")=""
DO EN^XUTMDEVQ("GO^PSNCLPR","PRINT DRUGS SORTED BY CLASS",.ZTSAVE)
IF POP
WRITE !,"No device selected",!
END KILL DIR,S,X,Y,ZTSAVE,^TMP($JOB,"PSN"),CL,DA,K,LINE,NA,TD,DIR
QUIT
+1 ;
GO ;ENTRY POINT
+1 KILL ^TMP($JOB,"PSN")
+2 SET DA=0
FOR
SET DA=$ORDER(^PSNDF(50.68,DA))
if 'DA
QUIT
SET NA=$PIECE(^(DA,0),"^")
Begin DoDot:1
+3 IF S'="S"
SET CL=$PIECE($GET(^PSNDF(50.68,DA,3)),"^")
SET CL=$PIECE(^PS(50.605,+CL,0),"^")
SET ^TMP($JOB,"PSN",CL,NA)=""
+4 IF S'="P"
SET K=0
FOR
SET K=$ORDER(^PSNDF(DA,4,K,0))
if 'K
QUIT
SET CL=$PIECE($GET(^PS(50.605,K,0)),"^")_$SELECT(S="B":"*",1:"")
SET ^TMP($JOB,"PSN",CL,NA)=""
End DoDot:1
+5 ;
+6 SET PG=1
SET TD=$TRANSLATE($$HTE^XLFDT($HOROLOG),"@"," ")
SET $PIECE(LINE,"-",IOM-1)=""
+7 DO HEAD
SET CL=""
FOR
SET CL=$ORDER(^TMP($JOB,"PSN",CL))
SET NA=""
if CL=""
QUIT
FOR
SET NA=$ORDER(^TMP($JOB,"PSN",CL,NA))
if NA=""
QUIT
WRITE !,CL,?S="B"*8+10,NA
IF $Y+4>IOSL
DO HEAD
+8 KILL CL,DA,K,LINE,NA,S,TD
if $DATA(ZTQUEUED)
SET ZTREQ="@"
DO ^%ZISC
QUIT
+9 ;
HEAD if $Y
WRITE @IOF
WRITE !,"VA PRODUCT LIST",?IOM-35," ",TD," PAGE ",PG,!!
if S="P"
WRITE "PRIMARY",!
if S="S"
WRITE "SECONDARY",!
if S="B"
WRITE "PRIMARY OR",!,"SECONDARY",!,"VA CLASS CODE"
if S'="B"
WRITE "VA CLASS",!,"CODE"
WRITE ?S="B"*10+12,"VA PRODUCT NAME",!,LINE,!
SET PG=PG+1
QUIT
DISC WRITE !!,"***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 WRITE " 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.",!!
QUIT
