- PSNCLS ;BIR/WRT-VA Drug Class Report ;01/12/98 5:18 PM
- ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
- W !!,"This report will display the VA Drug Classification code and class name.",!
- R "Would you also like to see the class descriptions? N// ",ANS:DTIME S:'$T ANS="^" G:ANS["^" DONE S:ANS']"" ANS="N" I $D(ANS),ANS["?" D CLS^PSNHELP1 K ANS G PSNCLS
- I ANS?.E1C.E K ANS G PSNCLS
- I ANS["^" G DONE
- SORT S DIC="^PS(50.605,",L=0,BY="@CODE,@TYPE",FR="?,",TO="?,",DHD="VA DRUG CLASSIFICATION CODES",FLDS="[PSNPRINT]" D EN1^DIP
- DONE K ANS,NOD Q
- PRINT W !,$S($P(^PS(50.605,D0,0),"^",4)=0:$P(^(0),"^"),$P(^PS(50.605,D0,0),"^",4)=1:" "_$P(^(0),"^"),$P(^PS(50.605,D0,0),"^",4)=2:" "_$P(^(0),"^"),1:$P(^PS(50.605,D0,0),"^")),?14,$P(^(0),"^",2)
- I $D(ANS),"Yy"[$E(ANS),$D(^PS(50.605,D0,1,0)) F NOD=0:0 S NOD=$O(^PS(50.605,D0,1,NOD)) Q:'NOD W !,$P(^PS(50.605,D0,1,NOD,0),"^",1)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNCLS 880 printed Feb 18, 2025@23:49:57 Page 2
- PSNCLS ;BIR/WRT-VA Drug Class Report ;01/12/98 5:18 PM
- +1 ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
- +2 WRITE !!,"This report will display the VA Drug Classification code and class name.",!
- +3 READ "Would you also like to see the class descriptions? N// ",ANS:DTIME
- if '$TEST
- SET ANS="^"
- if ANS["^"
- GOTO DONE
- if ANS']""
- SET ANS="N"
- IF $DATA(ANS)
- IF ANS["?"
- DO CLS^PSNHELP1
- KILL ANS
- GOTO PSNCLS
- +4 IF ANS?.E1C.E
- KILL ANS
- GOTO PSNCLS
- +5 IF ANS["^"
- GOTO DONE
- SORT SET DIC="^PS(50.605,"
- SET L=0
- SET BY="@CODE,@TYPE"
- SET FR="?,"
- SET TO="?,"
- SET DHD="VA DRUG CLASSIFICATION CODES"
- SET FLDS="[PSNPRINT]"
- DO EN1^DIP
- DONE KILL ANS,NOD
- QUIT
- PRINT WRITE !,$SELECT($PIECE(^PS(50.605,D0,0),"^",4)=0:$PIECE(^(0),"^"),$PIECE(^PS(50.605,D0,0),"^",4)=1:" "_$PIECE(^(0),"^"),$PIECE(^PS(50.605,D0,0),"^",4)=2:" "_$PIECE(^(0),"^"),1:$PIECE(^PS(50.605,D0,0),"^")),?14,$PIECE(^(0),"^",2)
- +1 IF $DATA(ANS)
- IF "Yy"[$EXTRACT(ANS)
- IF $DATA(^PS(50.605,D0,1,0))
- FOR NOD=0:0
- SET NOD=$ORDER(^PS(50.605,D0,1,NOD))
- if 'NOD
- QUIT
- WRITE !,$PIECE(^PS(50.605,D0,1,NOD,0),"^",1)
- +2 QUIT