PSSNOUNR ;BIR/RTR-Dosage Form and Noun report ;03/24/00
;;1.0;PHARMACY DATA MANAGEMENT;**34,48,211**;9/30/97;Build 20
;
EN ;
W !!,"This report shows the Dosage Forms and Nouns, along with the package use for",!,"each Noun and the resulting Local Possible Dosage.",!
K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS I $G(POP) W !!,"Nothing queued to print.",! Q
I $D(IO("Q")) S ZTRTN="START^PSSNOUNR",ZTDESC="Dosage Form/Noun Report" D ^%ZTLOAD K %ZIS W !,"Report queued to print.",! Q
START ;
U IO
S PSSOUT=0,PSSDV=$S($E(IOST)="C":"C",1:"P"),PSSCT=1
K PSSLINE S $P(PSSLINE,"-",78)=""
D NOHD
S PSSDF="" F S PSSDF=$O(^PS(50.606,"B",PSSDF)) Q:PSSDF=""!($G(PSSOUT)) F PSSN=0:0 S PSSN=$O(^PS(50.606,"B",PSSDF,PSSN)) Q:'PSSN!($G(PSSOUT)) D
.N PSSMDF
.S PSSNODE=$G(^PS(50.606,PSSN,0)) I $P(PSSNODE,"^",2),$P(PSSNODE,"^",2)<DT Q
.I ($Y+5)>IOSL D NOHD Q:$G(PSSOUT)
.W !!,$P(PSSNODE,"^")
.S PSSMDF=$$GETMDF(PSSN) W $S($L(PSSMDF):" ["_PSSMDF_"]",1:"") W " "
.K PSSDAR F PSSDUP=0:0 S PSSDUP=$O(^PS(50.606,PSSN,"DUPD",PSSDUP)) Q:'PSSDUP I $P($G(^(PSSDUP,0)),"^") S PSSDAR($P($G(^(0)),"^"))=""
.I $O(PSSDAR(0)) W ?68,"(" F PSSX=0:0 S PSSX=$O(PSSDAR(PSSX)) Q:'PSSX W PSSX W:$O(PSSDAR(PSSX)) ","
.I $O(PSSDAR(0)) W ")"
.I ($Y+5)>IOSL D NOHD Q:$G(PSSOUT)
.S PSSNFLAG=0
.F PSSNN=0:0 S PSSNN=$O(^PS(50.606,PSSN,"NOUN",PSSNN)) Q:'PSSNN!($G(PSSOUT)) S PSSNAME=$P($G(^(PSSNN,0)),"^"),PSSPAK=$P($G(^(0)),"^",2) I PSSNAME'="" S PSSNFLAG=1 D
..I ($Y+5)>IOSL D NOHD Q:$G(PSSOUT)
..I '$O(PSSDAR(0)) W !?2,$G(PSSNAME) D Q
...I $G(PSSPAK)="" W ?42,"(No package)" Q
...W ?61,$S($L($G(PSSPAK))>1:$G(PSSPAK),1:" "_$G(PSSPAK))_"--> "_$G(PSSNAME)
..I $G(PSSPAK)="" W !?2,$G(PSSNAME),?61,"(No package)" Q
..W !?2,$G(PSSNAME),?61,$S($L($G(PSSPAK))>1:$G(PSSPAK),1:" "_$G(PSSPAK))
..S PSSZC=1 F PSSZ=0:0 S PSSZ=$O(PSSDAR(PSSZ)) Q:'PSSZ!($G(PSSOUT)) D
...I PSSZC=1 D PARN W "--> "_PSSZ_" "_$S($G(PSSXN)'="":$G(PSSXN),1:$G(PSSNAME)) S PSSZC=PSSZC+1 Q
...I ($Y+5)>IOSL D NOHD Q:$G(PSSOUT)
...D PARN W !?61,$S($L($G(PSSPAK))>1:$G(PSSPAK),1:" "_$G(PSSPAK)),"--> ",PSSZ_" "_$S($G(PSSXN)'="":$G(PSSXN),1:$G(PSSNAME))
.I '$G(PSSNFLAG) W !?2,"(No Nouns)"
END ;
I '$G(PSSOUT),$G(PSSDV)="C" W !!,"End of Report." K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
I $G(PSSDV)="C" W !
E W @IOF
K PSSDF,PSSN,PSSOUT,PSSLINE,PSSDV,PSSCT,PSSDAR,PSSDUP,PSSX,PSSNN,PSSNFLAG,PSSNAME,PSSNODE,PSSPAK,PSSZ,PSSZC,PSSXN,PSSXNX D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
NOHD ;
I $G(PSSDV)="C",$G(PSSCT)'=1 W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSOUT=1 Q
W @IOF W !,"Dosage Form"," [RxNorm Name]",?40,"Dispense Units per Dose",?69,"PAGE: "_$G(PSSCT) S PSSCT=PSSCT+1
;W !,"RxNorm Dose Form"
W !?2,"Noun(s)",?36,"Package-->Local Possible Dosage",!,PSSLINE
Q
PARN ;
K PSSXN,PSSXNX
Q:$G(PSSNAME)=""
Q:$L(PSSNAME)'>3
S PSSXNX=$E(PSSNAME,($L(PSSNAME)-2),$L(PSSNAME))
I $G(PSSXNX)="(S)"!($G(PSSXNX)="(s)") D
.I $G(PSSZ)'>1 S PSSXN=$E(PSSNAME,1,($L(PSSNAME)-3))
.I $G(PSSZ)>1 S PSSXN=$E(PSSNAME,1,($L(PSSNAME)-3))_$E(PSSXNX,2)
Q
;
GETMDF(PSSDFI) ; Get RxNorm Dose Form name from MASTER DOSAGE FORM (#50.60699) file
; Input: PSSDFI - Dosage Form IEN from DOSAGE FORM (#50.606) file.
N PSSMDFI,PSSMDFN
S PSSMDFN=""
S PSSMDFI=$P($G(^PS(50.606,+$G(PSSDFI),"MASTER")),"^")
I $L(PSSMDFI) S PSSMDFN=$P($G(^PSMDF(50.60699,PSSMDFI,0)),"^")
Q PSSMDFN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSNOUNR 3451 printed Sep 23, 2025@20:08:59 Page 2
PSSNOUNR ;BIR/RTR-Dosage Form and Noun report ;03/24/00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**34,48,211**;9/30/97;Build 20
+2 ;
EN ;
+1 WRITE !!,"This report shows the Dosage Forms and Nouns, along with the package use for",!,"each Noun and the resulting Local Possible Dosage.",!
+2 KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
IF $GET(POP)
WRITE !!,"Nothing queued to print.",!
QUIT
+3 IF $DATA(IO("Q"))
SET ZTRTN="START^PSSNOUNR"
SET ZTDESC="Dosage Form/Noun Report"
DO ^%ZTLOAD
KILL %ZIS
WRITE !,"Report queued to print.",!
QUIT
START ;
+1 USE IO
+2 SET PSSOUT=0
SET PSSDV=$SELECT($EXTRACT(IOST)="C":"C",1:"P")
SET PSSCT=1
+3 KILL PSSLINE
SET $PIECE(PSSLINE,"-",78)=""
+4 DO NOHD
+5 SET PSSDF=""
FOR
SET PSSDF=$ORDER(^PS(50.606,"B",PSSDF))
if PSSDF=""!($GET(PSSOUT))
QUIT
FOR PSSN=0:0
SET PSSN=$ORDER(^PS(50.606,"B",PSSDF,PSSN))
if 'PSSN!($GET(PSSOUT))
QUIT
Begin DoDot:1
+6 NEW PSSMDF
+7 SET PSSNODE=$GET(^PS(50.606,PSSN,0))
IF $PIECE(PSSNODE,"^",2)
IF $PIECE(PSSNODE,"^",2)<DT
QUIT
+8 IF ($Y+5)>IOSL
DO NOHD
if $GET(PSSOUT)
QUIT
+9 WRITE !!,$PIECE(PSSNODE,"^")
+10 SET PSSMDF=$$GETMDF(PSSN)
WRITE $SELECT($LENGTH(PSSMDF):" ["_PSSMDF_"]",1:"")
WRITE " "
+11 KILL PSSDAR
FOR PSSDUP=0:0
SET PSSDUP=$ORDER(^PS(50.606,PSSN,"DUPD",PSSDUP))
if 'PSSDUP
QUIT
IF $PIECE($GET(^(PSSDUP,0)),"^")
SET PSSDAR($PIECE($GET(^(0)),"^"))=""
+12 IF $ORDER(PSSDAR(0))
WRITE ?68,"("
FOR PSSX=0:0
SET PSSX=$ORDER(PSSDAR(PSSX))
if 'PSSX
QUIT
WRITE PSSX
if $ORDER(PSSDAR(PSSX))
WRITE ","
+13 IF $ORDER(PSSDAR(0))
WRITE ")"
+14 IF ($Y+5)>IOSL
DO NOHD
if $GET(PSSOUT)
QUIT
+15 SET PSSNFLAG=0
+16 FOR PSSNN=0:0
SET PSSNN=$ORDER(^PS(50.606,PSSN,"NOUN",PSSNN))
if 'PSSNN!($GET(PSSOUT))
QUIT
SET PSSNAME=$PIECE($GET(^(PSSNN,0)),"^")
SET PSSPAK=$PIECE($GET(^(0)),"^",2)
IF PSSNAME'=""
SET PSSNFLAG=1
Begin DoDot:2
+17 IF ($Y+5)>IOSL
DO NOHD
if $GET(PSSOUT)
QUIT
+18 IF '$ORDER(PSSDAR(0))
WRITE !?2,$GET(PSSNAME)
Begin DoDot:3
+19 IF $GET(PSSPAK)=""
WRITE ?42,"(No package)"
QUIT
+20 WRITE ?61,$SELECT($LENGTH($GET(PSSPAK))>1:$GET(PSSPAK),1:" "_$GET(PSSPAK))_"--> "_$GET(PSSNAME)
End DoDot:3
QUIT
+21 IF $GET(PSSPAK)=""
WRITE !?2,$GET(PSSNAME),?61,"(No package)"
QUIT
+22 WRITE !?2,$GET(PSSNAME),?61,$SELECT($LENGTH($GET(PSSPAK))>1:$GET(PSSPAK),1:" "_$GET(PSSPAK))
+23 SET PSSZC=1
FOR PSSZ=0:0
SET PSSZ=$ORDER(PSSDAR(PSSZ))
if 'PSSZ!($GET(PSSOUT))
QUIT
Begin DoDot:3
+24 IF PSSZC=1
DO PARN
WRITE "--> "_PSSZ_" "_$SELECT($GET(PSSXN)'="":$GET(PSSXN),1:$GET(PSSNAME))
SET PSSZC=PSSZC+1
QUIT
+25 IF ($Y+5)>IOSL
DO NOHD
if $GET(PSSOUT)
QUIT
+26 DO PARN
WRITE !?61,$SELECT($LENGTH($GET(PSSPAK))>1:$GET(PSSPAK),1:" "_$GET(PSSPAK)),"--> ",PSSZ_" "_$SELECT($GET(PSSXN)'="":$GET(PSSXN),1:$GET(PSSNAME))
End DoDot:3
End DoDot:2
+27 IF '$GET(PSSNFLAG)
WRITE !?2,"(No Nouns)"
End DoDot:1
END ;
+1 IF '$GET(PSSOUT)
IF $GET(PSSDV)="C"
WRITE !!,"End of Report."
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+2 IF $GET(PSSDV)="C"
WRITE !
+3 IF '$TEST
WRITE @IOF
+4 KILL PSSDF,PSSN,PSSOUT,PSSLINE,PSSDV,PSSCT,PSSDAR,PSSDUP,PSSX,PSSNN,PSSNFLAG,PSSNAME,PSSNODE,PSSPAK,PSSZ,PSSZC,PSSXN,PSSXNX
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 QUIT
NOHD ;
+1 IF $GET(PSSDV)="C"
IF $GET(PSSCT)'=1
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSOUT=1
QUIT
+2 WRITE @IOF
WRITE !,"Dosage Form"," [RxNorm Name]",?40,"Dispense Units per Dose",?69,"PAGE: "_$GET(PSSCT)
SET PSSCT=PSSCT+1
+3 ;W !,"RxNorm Dose Form"
+4 WRITE !?2,"Noun(s)",?36,"Package-->Local Possible Dosage",!,PSSLINE
+5 QUIT
PARN ;
+1 KILL PSSXN,PSSXNX
+2 if $GET(PSSNAME)=""
QUIT
+3 if $LENGTH(PSSNAME)'>3
QUIT
+4 SET PSSXNX=$EXTRACT(PSSNAME,($LENGTH(PSSNAME)-2),$LENGTH(PSSNAME))
+5 IF $GET(PSSXNX)="(S)"!($GET(PSSXNX)="(s)")
Begin DoDot:1
+6 IF $GET(PSSZ)'>1
SET PSSXN=$EXTRACT(PSSNAME,1,($LENGTH(PSSNAME)-3))
+7 IF $GET(PSSZ)>1
SET PSSXN=$EXTRACT(PSSNAME,1,($LENGTH(PSSNAME)-3))_$EXTRACT(PSSXNX,2)
End DoDot:1
+8 QUIT
+9 ;
GETMDF(PSSDFI) ; Get RxNorm Dose Form name from MASTER DOSAGE FORM (#50.60699) file
+1 ; Input: PSSDFI - Dosage Form IEN from DOSAGE FORM (#50.606) file.
+2 NEW PSSMDFI,PSSMDFN
+3 SET PSSMDFN=""
+4 SET PSSMDFI=$PIECE($GET(^PS(50.606,+$GET(PSSDFI),"MASTER")),"^")
+5 IF $LENGTH(PSSMDFI)
SET PSSMDFN=$PIECE($GET(^PSMDF(50.60699,PSSMDFI,0)),"^")
+6 QUIT PSSMDFN
