- 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 Feb 18, 2025@23:49:56 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