- PSSNOUNR ;BIR/RTR-Dosage Form and Noun report ;03/24/00
- ;;1.0;PHARMACY DATA MANAGEMENT;**34,48**;9/30/97
- ;
- 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
- .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,"^") 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 ?34,"(" 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 ?34,"(No package)" Q
- ...W ?34,$S($L($G(PSSPAK))>1:$G(PSSPAK),1:" "_$G(PSSPAK))_"--> "_$G(PSSNAME)
- ..I $G(PSSPAK)="" W !?2,$G(PSSNAME),?34,"(No package)" Q
- ..W !?2,$G(PSSNAME),?34,$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 !?34,$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",?34,"Dispense Units per Dose",?69,"PAGE: "_$G(PSSCT) S PSSCT=PSSCT+1
- W !?2,"Noun(s)",?26,"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
- PSSNOUNR ;BIR/RTR-Dosage Form and Noun report ;03/24/00
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**34,48**;9/30/97
- +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 SET PSSNODE=$GET(^PS(50.606,PSSN,0))
- IF $PIECE(PSSNODE,"^",2)
- IF $PIECE(PSSNODE,"^",2)<DT
- QUIT
- +7 IF ($Y+5)>IOSL
- DO NOHD
- IF $GET(PSSOUT)
- QUIT
- +8 WRITE !!,$PIECE(PSSNODE,"^")
- 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)),"^"))=""
- +9 IF $ORDER(PSSDAR(0))
- WRITE ?34,"("
- FOR PSSX=0:0
- SET PSSX=$ORDER(PSSDAR(PSSX))
- IF 'PSSX
- QUIT
- WRITE PSSX
- IF $ORDER(PSSDAR(PSSX))
- WRITE ","
- +10 IF $ORDER(PSSDAR(0))
- WRITE ")"
- +11 IF ($Y+5)>IOSL
- DO NOHD
- IF $GET(PSSOUT)
- QUIT
- +12 SET PSSNFLAG=0
- +13 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
- +14 IF ($Y+5)>IOSL
- DO NOHD
- IF $GET(PSSOUT)
- QUIT
- +15 IF '$ORDER(PSSDAR(0))
- WRITE !?2,$GET(PSSNAME)
- Begin DoDot:3
- +16 IF $GET(PSSPAK)=""
- WRITE ?34,"(No package)"
- QUIT
- +17 WRITE ?34,$SELECT($LENGTH($GET(PSSPAK))>1:$GET(PSSPAK),1:" "_$GET(PSSPAK))_"--> "_$GET(PSSNAME)
- End DoDot:3
- QUIT
- +18 IF $GET(PSSPAK)=""
- WRITE !?2,$GET(PSSNAME),?34,"(No package)"
- QUIT
- +19 WRITE !?2,$GET(PSSNAME),?34,$SELECT($LENGTH($GET(PSSPAK))>1:$GET(PSSPAK),1:" "_$GET(PSSPAK))
- +20 SET PSSZC=1
- FOR PSSZ=0:0
- SET PSSZ=$ORDER(PSSDAR(PSSZ))
- IF 'PSSZ!($GET(PSSOUT))
- QUIT
- Begin DoDot:3
- +21 IF PSSZC=1
- DO PARN
- WRITE "--> "_PSSZ_" "_$SELECT($GET(PSSXN)'="":$GET(PSSXN),1:$GET(PSSNAME))
- SET PSSZC=PSSZC+1
- QUIT
- +22 IF ($Y+5)>IOSL
- DO NOHD
- IF $GET(PSSOUT)
- QUIT
- +23 DO PARN
- WRITE !?34,$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
- +24 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",?34,"Dispense Units per Dose",?69,"PAGE: "_$GET(PSSCT)
- SET PSSCT=PSSCT+1
- +3 WRITE !?2,"Noun(s)",?26,"Package-->Local Possible Dosage",!,PSSLINE
- +4 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
