PSSDRDOS ;BIR/RTR-Display Dosing related information for DRUG File(#50) entry ;08/20/11
;;1.0;PHARMACY DATA MANAGEMENT;**160,173,195,178,206**;9/30/97;Build 10
;
;Reference to $$PROD0^PSNAPIS(P1,P3) supported by DBIA #2531
;Reference to $$OVRIDE^PSNAPIS(P1,P3) supported by DBIA #2531
;
EN ;
N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DA,DR,DLAYGO,DIDEL,%,%DT,D0,I,J,XX,D
N PSSVVHIN,PSSVVHZR,PSSVVHND,PSSVVHN1,PSSVVHN3,PSSVVHRS,PSSVVHMT,PSSVVHOV,PSSVVHNM,PSSVVHDF,PSSVVHGC,PSSVVHDX,PSSVVHLG,PSSVVHQT,PSSVVHL3,PSSVVHL4
N PSSVVHA1,PSSVVHA2,PSSVVHA3,PSSVVHA4,PSSVVHA5,PSSVVHA7,PSSVVHA8,PSSVVHA9,PSSVVHAR,PSSIEN,PSSVVHXX,PSSVVHPL,PSSVVHHH
N PSSVVHL1,PSSVVHL2
S $P(PSSVVHL1,"=",75)=""
S $P(PSSVVHL2,"-",75)=""
EN1 ;Come back through to prompt for another drug before exiting option
K X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DA,DR,DLAYGO,DIDEL,%,%DT,D0,I,J,XX,D
K PSSVVHIN,PSSVVHZR,PSSVVHND,PSSVVHN1,PSSVVHN3,PSSVVHRS,PSSVVHMT,PSSVVHOV,PSSVVHNM,PSSVVHDF,PSSVVHGC,PSSVVHDX,PSSVVHLG,PSSVVHQT,PSSVVHL3,PSSVVHL4
K PSSVVHA1,PSSVVHA2,PSSVVHA3,PSSVVHA4,PSSVVHA5,PSSVVHA7,PSSVVHA8,PSSVVHA9,PSSVVHAR,PSSIEN,PSSVVHXX,PSSVVHPL,PSSVVHHH
W ! K DIC,X,DTOUT,DUOUT S DIC="^PSDRUG(",DIC(0)="AEQMZ" D ^DIC K DIC,X I Y<0!($D(DUOUT))!($D(DTOUT)) W ! Q
S PSSVVHIN=+Y
S (PSSVVHDX,PSSVVHQT,PSSVVHLG)=0,(PSSVVHOV,PSSVVHGC,PSSVVHNM,PSSVVHDF,PSSVVHPL,PSSVVHHH)=""
S PSSVVHZR=$G(^PSDRUG(PSSVVHIN,0)),PSSVVHND=$G(^PSDRUG(PSSVVHIN,"ND")),PSSVVHMT=1
S PSSVVHN1=$P(PSSVVHND,"^"),PSSVVHN3=$P(PSSVVHND,"^",3) I 'PSSVVHN1!('PSSVVHN3) S PSSVVHMT=0
I 'PSSVVHMT S PSSVVHLG=1 G NOTM
S PSSVVHRS=$$PROD0^PSNAPIS(PSSVVHN1,PSSVVHN3),PSSVVHOV=$$OVRIDE^PSNAPIS(PSSVVHN1,PSSVVHN3) S PSSVVHHH=$S(PSSVVHOV:1,1:0)
S PSSVVHNM=$P(PSSVVHRS,"^"),PSSVVHDF=$P(PSSVVHRS,"^",2),PSSVVHGC=$P(PSSVVHRS,"^",7)
I PSSVVHDF S PSSVVHPL=0 I $P($G(^PS(50.606,PSSVVHDF,1)),"^") S (PSSVVHDX,PSSVVHPL)=1
S PSSVVHLG=$$ELG
;
NOTM ;Jump to here if not matched to National Drug File
W @IOF
S PSSVVHL3=$L($P(PSSVVHZR,"^")),PSSVVHL4=$S(PSSVVHGC'="":$L(PSSVVHGC),1:4) D
.I (PSSVVHL3+PSSVVHL4)<54 W !?12,$P(PSSVVHZR,"^")_" (GCNSEQNO: "_$S(PSSVVHGC'="":PSSVVHGC,1:"None")_")" D PAUSE Q
.W !?12,$P(PSSVVHZR,"^") D PAUSE Q:PSSVVHQT
.W !?12,"(GCNSEQNO: "_$S(PSSVVHGC'="":PSSVVHGC,1:"None")_")" D PAUSE
G:PSSVVHQT EN1
W !,PSSVVHL1 D PAUSE G:PSSVVHQT EN1
S PSSVVHL3=$L(PSSVVHNM) D
.I PSSVVHL3<63 W !,"VA PRODUCT NAME: "_PSSVVHNM D PAUSE Q
.W !,"VA PRODUCT NAME:" D PAUSE Q:PSSVVHQT
.W !?2,PSSVVHNM D PAUSE
G:PSSVVHQT EN1
W !,"NDF DOSAGE FORM: "_$S(PSSVVHDF:$P($G(^PS(50.606,+PSSVVHDF,0)),"^"),1:"") D PAUSE G:PSSVVHQT EN1
W !,"DEA, SPECIAL HDLG: "_$P(PSSVVHZR,"^",3)_" VA DRUG CLASS: "_$P(PSSVVHZR,"^",2) D PAUSE G:PSSVVHQT EN1
W !,"EXCLUDE DOSAGE FORM FROM DOSAGE CHECKS: " W $S(PSSVVHPL:"YES",PSSVVHPL=0:"NO",1:"") D PAUSE G:PSSVVHQT EN1
W !,"OVERRIDE DOSAGE FORM DOSE CHECK EXCLUSION FOR VA PRODUCT: " W $S(PSSVVHHH:"YES",PSSVVHHH=0:"NO",1:"") D PAUSE G:PSSVVHQT EN1
W ! D PAUSE G:PSSVVHQT EN1
W !?7,"***DRUG "_$S(PSSVVHLG:"NOT ",1:"")_"ELIGIBLE FOR DOSAGE CHECKS***" D PAUSE G:PSSVVHQT EN1
W !,PSSVVHL2 D PAUSE G:PSSVVHQT EN1
;
S PSSVVHA1=$G(^PSDRUG(PSSVVHIN,"DOS")) S PSSVVHL3=0
S PSSVVHA2=$P(PSSVVHA1,"^"),PSSVVHA3=$P(PSSVVHA1,"^",2) I PSSVVHA3,$P($G(^PS(50.607,+PSSVVHA3,0)),"^")'["/" S PSSVVHL3=$L($P($G(^PS(50.607,+PSSVVHA3,0)),"^"))
W !,"Strength: "_$S($E($G(PSSVVHA2),1)=".":"0",1:"")_$G(PSSVVHA2) D
.I PSSVVHA3="" W " Unit:" D PAUSE Q
.I PSSVVHL3<46 W " Unit: "_$S($P($G(^PS(50.607,+$G(PSSVVHA3),0)),"^")'["/":$P($G(^(0)),"^"),1:"") D PAUSE Q
.W ! D PAUSE Q:PSSVVHQT
.W " Unit: "_$S($P($G(^PS(50.607,+$G(PSSVVHA3),0)),"^")'["/":$P($G(^(0)),"^"),1:"") D PAUSE Q
G:PSSVVHQT EN1
W !,"POSSIBLE DOSAGES:" D PAUSE G:PSSVVHQT EN1 D
.F PSSVVHA4=0:0 S PSSVVHA4=$O(^PSDRUG(PSSVVHIN,"DOS1",PSSVVHA4)) Q:'PSSVVHA4!(PSSVVHQT) D
..S PSSVVHA5=$G(^PSDRUG(PSSVVHIN,"DOS1",PSSVVHA4,0))
..W !," DISPENSE UNITS PER DOSE: " D
...W $S($E($P(PSSVVHA5,"^"),1)=".":"0",1:"")_$P(PSSVVHA5,"^")
...S X=$P(PSSVVHA5,"^"),PSSIEN=PSSVVHIN D SET^PSSDOSLZ S PSSVVHXX=$G(X)
...W ?43,"DOSE: ",PSSVVHXX
...I $L(PSSVVHXX)'>14 W ?65,"PACKAGE: ",$P(PSSVVHA5,U,3) D PAUSE Q
...W ! D PAUSE Q:PSSVVHQT
...W ?65,"PACKAGE: ",$P(PSSVVHA5,U,3) D PAUSE
..Q:PSSVVHQT
..W !," BCMA UNITS PER DOSE: "_$S($E($P(PSSVVHA5,"^",4),1)=".":"0",1:"")_$P(PSSVVHA5,"^",4) D PAUSE
G:PSSVVHQT EN1
W !!,"LOCAL POSSIBLE DOSAGES:" D PAUSE G:PSSVVHQT EN1 D
.F PSSVVHA7=0:0 S PSSVVHA7=$O(^PSDRUG(PSSVVHIN,"DOS2",PSSVVHA7)) Q:'PSSVVHA7!(PSSVVHQT) D
..S PSSVVHA8=$G(^PSDRUG(PSSVVHIN,"DOS2",PSSVVHA7,0)) W !," LOCAL POSSIBLE DOSAGE: " D
...I $L($P(PSSVVHA8,"^"))'>37 W $P(PSSVVHA8,"^"),?65,"PACKAGE: ",$P(PSSVVHA8,"^",2) D PAUSE Q:PSSVVHQT D WXFPT(PSSVVHA8) Q
...W !,?3,$P(PSSVVHA8,"^"),?65,"PACKAGE: ",$P(PSSVVHA8,"^",2) D PAUSE Q:PSSVVHQT D WXFPT(PSSVVHA8)
G:PSSVVHQT EN1
W !,PSSVVHL2 D PAUSE G:PSSVVHQT EN1
I $G(PSSVVHGC)=""!(PSSVVHLG) D G EN1
.W !,"FDB ROUTES:" D PAUSE Q:PSSVVHQT
.W !,"FDB DOSE UNITS:" D PAUSE Q:PSSVVHQT
.W !,"BSA REQUIRED FOR DOSAGE CHECKS:" D PAUSE Q:PSSVVHQT
.W !,"WEIGHT REQUIRED FOR DOSAGE CHECKS:" D PAUSE
D NGC,NGCK
I $P($G(^PSDRUG(PSSVVHIN,"ND")),"^",3)'="" D CLEFF^PSSDRDO2(PSSVVHN3) D PAUSE Q:PSSVVHQT ; Clinical Effects of Drug fields
G EN1
;
WXFPT(PSSVVHCL) ;
N PSSVVHC1,PSSVVHC2,PSSVVHC3,PSSVVHC4,PSSVVHC5,PSSVVHC6,PSSVVHC7
S PSSVVHC4=""
S PSSVVHC1=$P(PSSVVHCL,"^",3),PSSVVHC2=$P(PSSVVHCL,"^",5),PSSVVHC3=$P(PSSVVHCL,"^",6)
I PSSVVHC2 S PSSVVHC4=$P($G(^PS(51.24,+PSSVVHC2,0)),"^")
S PSSVVHC5=$S($E(PSSVVHC3)=".":"0",1:"")_PSSVVHC3
S PSSVVHC7=$S($E(PSSVVHC1)=".":"0",1:"")_PSSVVHC1
S PSSVVHC6=$L(PSSVVHC5)
W !?4,"BCMA UNITS PER DOSE: "_PSSVVHC7 D PAUSE Q:PSSVVHQT
I PSSVVHC6<12 W !?4," NUMERIC DOSE: "_PSSVVHC5,?38,"DOSE UNIT: "_PSSVVHC4 D PAUSE Q
W !,?4," NUMERIC DOSE: "_PSSVVHC5 D PAUSE Q:PSSVVHQT
W !,?38,"DOSE UNIT: "_PSSVVHC4 D PAUSE
Q
;
PAUSE ;
I ($Y+5)'>IOSL Q
W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue, '^' to exit" D ^DIR K DIR I 'Y S PSSVVHQT=1 Q
W @IOF
Q
;
ELG() ;Is drug Dose Call Eligible, for matched drugs
N PSSVVHDA
S PSSVVHDA=PSSVVHDF
;1=exempt from Dose Check, 0=not exempt from Dose check
I $P(PSSVVHZR,"^",3)["S"!($E($P(PSSVVHZR,"^",2),1,2)="XA") Q 1
I $G(PSSVVHGC)="" Q 1
I $G(PSSVVHDA)'>0,$P($G(^PSDRUG(PSSVVHIN,2)),"^") S PSSVVHDA=$P($G(^PS(50.7,+$P($G(^PSDRUG(PSSVVHIN,2)),"^"),0)),"^",2) I PSSVVHDA,$P($G(^PS(50.606,+$G(PSSVVHDA),1)),"^") S PSSVVHDX=1
I PSSVVHOV=""!('$G(PSSVVHDA))!($P($G(^PS(50.606,+$G(PSSVVHDA),1)),"^")="") Q 0
I $P($G(^PS(50.606,+$G(PSSVVHDA),1)),"^"),'PSSVVHOV Q 1
I '$P($G(^PS(50.606,+$G(PSSVVHDA),1)),"^"),PSSVVHOV Q 1
Q 0
;
NGC ;Print First Databank data from Dosing records
N PSSDCR1,PSSDCR2,PSSDCR3,PSSDCR4,PSSDCR5,PSSDCR6,PSSDCR7,PSSDCR8,PSSDCR9,PSSDCRN3,PSSDCRVL,PSSDCRMR,PSSDCRUN,PSSDCRWT,PSSDCRBS,PSSDCRCO,PSSDCRF1,PSSDCRF2,PSSDCRF3,PSSDCRF4,PSSDCRF5,PSSDCRX1,PSSDCRX2,PSSDCRXX,PSSDCRK1,PSSDCRK2
N PSSDCRJ1,PSSDCRJ2,PSSDCRJ3,PSSDCRJ4,PSSDCRJ5,PSSDCRJ6
D NGCK
D EN^PSSFDBDI(PSSVVHGC,.PSSDCRVL)
I $P($G(PSSDCRVL(0)),"^")=-1 D Q
.W !,"Vendor database cannot be reached. FDB Dosing information could not be" D PAUSE Q:PSSVVHQT
.W !,"retrieved at this time." D PAUSE
;
;set arrays used for printing from doseRanges records
S (PSSDCRX1,PSSDCRX2)=1
S PSSVVHGC=+PSSVVHGC
S PSSDCR1="" F S PSSDCR1=$O(^TMP($J,"PSSFDBDI",PSSVVHGC,"doseRanges",PSSDCR1)) Q:PSSDCR1="" D
.S PSSDCR2=$G(^TMP($J,"PSSFDBDI",PSSVVHGC,"doseRanges",PSSDCR1,1,0)) Q:$P(PSSDCR2,"^",4)'="SINGLE DOSE"&($P(PSSDCR2,"^",4)'="MAINTENANCE") S:$P(PSSDCR2,"^",6)'="" PSSDCRMR($P(PSSDCR2,"^",6))=""
.S PSSDCR5=$G(^TMP($J,"PSSFDBDI",PSSVVHGC,"doseRanges",PSSDCR1,5,0))
.S PSSDCR6=$G(^TMP($J,"PSSFDBDI",PSSVVHGC,"doseRanges",PSSDCR1,6,0))
.S PSSDCR7=$G(^TMP($J,"PSSFDBDI",PSSVVHGC,"doseRanges",PSSDCR1,7,0))
.S PSSDCRN3=$G(^TMP($J,"PSSFDBDI",PSSVVHGC,"doseRanges",PSSDCR1,3,0))
.F PSSDCR8=2,4,6,8 D
..S:$P(PSSDCR5,"^",PSSDCR8)'="" PSSDCRUN($P($P(PSSDCR5,"^",PSSDCR8),"/"))="" S:$P(PSSDCR6,"^",PSSDCR8)'="" PSSDCRUN($P($P(PSSDCR6,"^",PSSDCR8),"/"))=""
.F PSSDCR8=2,4 D
..S:$P(PSSDCR7,"^",PSSDCR8)'="" PSSDCRUN($P($P(PSSDCR7,"^",PSSDCR8),"/"))=""
.I $P(PSSDCR2,"^",7)'="",$P(PSSDCR2,"^",8)'="" S PSSDCRCO=$P(PSSDCR2,"^",7)_"-"_$P(PSSDCR2,"^",8) D
..I $P(PSSDCRN3,"^")="true"!($P(PSSDCRN3,"^")="false") I '$$DUP1 S PSSDCRBS(PSSDCRX1,PSSDCRCO,$P(PSSDCRN3,"^"))=$P(PSSDCR2,"^",6)_"^"_$P(PSSDCR2,"^",4) S PSSDCRX1=PSSDCRX1+1
..I $P(PSSDCRN3,"^",2)="true"!($P(PSSDCRN3,"^",2)="false") I '$$DUP2 S PSSDCRWT(PSSDCRX2,PSSDCRCO,$P(PSSDCRN3,"^",2))=$P(PSSDCR2,"^",6)_"^"_$P(PSSDCR2,"^",4) S PSSDCRX2=PSSDCRX2+1
;
;Removed all Min/Max Dosing records per CR 5781, CR 5783 and CCR 5778
W !,"FDB ROUTES: " S PSSDCR3=0 D
.S PSSDCR4="" F S PSSDCR4=$O(PSSDCRMR(PSSDCR4)) Q:PSSDCR4=""!(PSSVVHQT) D
..I 'PSSDCR3 W PSSDCR4 S PSSDCR3=1 D PAUSE Q
..W !?12,PSSDCR4 D PAUSE
I PSSVVHQT Q
;
W !,"FDB DOSE UNITS: " S PSSDCR3=0 D
.S PSSDCR4="" F S PSSDCR4=$O(PSSDCRUN(PSSDCR4)) Q:PSSDCR4=""!(PSSVVHQT) D
..I 'PSSDCR3 W PSSDCR4 S PSSDCR3=1 D PAUSE Q
..W !?16,PSSDCR4 D PAUSE
I PSSVVHQT Q
;
;Write BSA and WT required data
;If all Age ranges under BSA or WT, are the same do not list individual age ranges
;When listing Age ranges under BSA or WT, then within that Yes or No, if 2 or more and ranges exist, and one or more has
;a route associated with it, do not show the age range that does not have a route. Other than that, duplicates are not screened out.
S (PSSDCRF3,PSSDCRF4)="" D
.S PSSDCRXX="" F S PSSDCRXX=$O(PSSDCRBS(PSSDCRXX)) Q:PSSDCRXX=""!(PSSDCRF4) D
..S PSSDCRF1="" F S PSSDCRF1=$O(PSSDCRBS(PSSDCRXX,PSSDCRF1)) Q:PSSDCRF1=""!(PSSDCRF4) D
...S PSSDCRF2="" F S PSSDCRF2=$O(PSSDCRBS(PSSDCRXX,PSSDCRF1,PSSDCRF2)) Q:PSSDCRF2=""!(PSSDCRF4) D
....I PSSDCRF3="" S PSSDCRF3=PSSDCRF2 Q
....I PSSDCRF3'=PSSDCRF2 S PSSDCRF4=1 Q
....S PSSDCRF3=PSSDCRF2
W !,"BSA REQUIRED FOR DOSAGE CHECKS:" D
.I 'PSSDCRF4 W $S(PSSDCRF3="true":" YES",PSSDCRF3="false":" NO",1:"") D PAUSE Q
.;Resort by starting age for printing
.K PSSDCRJ1,PSSDCRJ2,PSSDCRJ3,PSSDCRJ4,PSSDCRJ5,PSSDCRJ6
.F PSSDCRJ1=1:1 Q:'$D(PSSDCRBS(PSSDCRJ1)) S PSSDCRJ2="" F S PSSDCRJ2=$O(PSSDCRBS(PSSDCRJ1,PSSDCRJ2)) Q:PSSDCRJ2="" D
..S PSSDCRJ3="" F S PSSDCRJ3=$O(PSSDCRBS(PSSDCRJ1,PSSDCRJ2,PSSDCRJ3)) Q:PSSDCRJ3="" S PSSDCRJ4=$P(PSSDCRJ2,"-") D
...S PSSDCRJ5(PSSDCRJ4,PSSDCRJ1,PSSDCRJ2,PSSDCRJ3)=PSSDCRBS(PSSDCRJ1,PSSDCRJ2,PSSDCRJ3)
.W !?2,"YES for Age in Days:" S PSSDCR3=0 D
..S PSSDCRJ6="" F S PSSDCRJ6=$O(PSSDCRJ5(PSSDCRJ6)) Q:PSSDCRJ6=""!(PSSVVHQT) D
...S PSSDCRXX="" F S PSSDCRXX=$O(PSSDCRJ5(PSSDCRJ6,PSSDCRXX)) Q:PSSDCRXX=""!(PSSVVHQT) D
....S PSSDCR4="" F S PSSDCR4=$O(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4)) Q:PSSDCR4=""!(PSSVVHQT) D
.....S PSSDCRF5="" F S PSSDCRF5=$O(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5)) Q:PSSDCRF5=""!(PSSVVHQT) D:PSSDCRF5="true"
......S PSSDCRK1=PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5)
......W:PSSDCR3 !?22 W " "_PSSDCR4_" " D Q:PSSVVHQT S PSSDCR3=1 D PAUSE Q
.......D LWRP(PSSDCRK1)
.Q:PSSVVHQT
.W !?3,"NO for Age in Days:" S PSSDCR3=0 D
..S PSSDCRJ6="" F S PSSDCRJ6=$O(PSSDCRJ5(PSSDCRJ6)) Q:PSSDCRJ6=""!(PSSVVHQT) D
...S PSSDCRXX="" F S PSSDCRXX=$O(PSSDCRJ5(PSSDCRJ6,PSSDCRXX)) Q:PSSDCRXX=""!(PSSVVHQT) D
....S PSSDCR4="" F S PSSDCR4=$O(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4)) Q:PSSDCR4=""!(PSSVVHQT) D
.....S PSSDCRF5="" F S PSSDCRF5=$O(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5)) Q:PSSDCRF5=""!(PSSVVHQT) D:PSSDCRF5="false"
......S PSSDCRK2=PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5)
......W:PSSDCR3 !?22 W " "_PSSDCR4_" " D Q:PSSVVHQT S PSSDCR3=1 D PAUSE Q
.......D LWRP(PSSDCRK2)
I PSSVVHQT Q
;
S (PSSDCRF3,PSSDCRF4)="" D
.S PSSDCRXX="" F S PSSDCRXX=$O(PSSDCRWT(PSSDCRXX)) Q:PSSDCRXX=""!(PSSDCRF4) D
..S PSSDCRF1="" F S PSSDCRF1=$O(PSSDCRWT(PSSDCRXX,PSSDCRF1)) Q:PSSDCRF1=""!(PSSDCRF4) D
...S PSSDCRF2="" F S PSSDCRF2=$O(PSSDCRWT(PSSDCRXX,PSSDCRF1,PSSDCRF2)) Q:PSSDCRF2=""!(PSSDCRF4) D
....I PSSDCRF3="" S PSSDCRF3=PSSDCRF2 Q
....I PSSDCRF3'=PSSDCRF2 S PSSDCRF4=1 Q
....S PSSDCRF3=PSSDCRF2
W !,"WEIGHT REQUIRED FOR DOSAGE CHECKS:" D
.I 'PSSDCRF4 W $S(PSSDCRF3="true":" YES",PSSDCRF3="false":" NO",1:"") D PAUSE Q
.;Resort by starting age for printing
.K PSSDCRJ1,PSSDCRJ2,PSSDCRJ3,PSSDCRJ4,PSSDCRJ5,PSSDCRJ6
.F PSSDCRJ1=1:1 Q:'$D(PSSDCRWT(PSSDCRJ1)) S PSSDCRJ2="" F S PSSDCRJ2=$O(PSSDCRWT(PSSDCRJ1,PSSDCRJ2)) Q:PSSDCRJ2="" D
..S PSSDCRJ3="" F S PSSDCRJ3=$O(PSSDCRWT(PSSDCRJ1,PSSDCRJ2,PSSDCRJ3)) Q:PSSDCRJ3="" S PSSDCRJ4=$P(PSSDCRJ2,"-") D
...S PSSDCRJ5(PSSDCRJ4,PSSDCRJ1,PSSDCRJ2,PSSDCRJ3)=PSSDCRWT(PSSDCRJ1,PSSDCRJ2,PSSDCRJ3)
.W !?2,"YES for Age in Days:" S PSSDCR3=0 D
..S PSSDCRJ6="" F S PSSDCRJ6=$O(PSSDCRJ5(PSSDCRJ6)) Q:PSSDCRJ6=""!(PSSVVHQT) D
...S PSSDCRXX="" F S PSSDCRXX=$O(PSSDCRJ5(PSSDCRJ6,PSSDCRXX)) Q:PSSDCRXX=""!(PSSVVHQT) D
....S PSSDCR4="" F S PSSDCR4=$O(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4)) Q:PSSDCR4=""!(PSSVVHQT) D
.....S PSSDCRF5="" F S PSSDCRF5=$O(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5)) Q:PSSDCRF5=""!(PSSVVHQT) D:PSSDCRF5="true"
......S PSSDCRK1=PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5)
......W:PSSDCR3 !?22 W " "_PSSDCR4_" " D Q:PSSVVHQT S PSSDCR3=1 D PAUSE Q
.......D LWRP(PSSDCRK1)
.Q:PSSVVHQT
.W !?3,"NO for Age in Days:" S PSSDCR3=0 D
..S PSSDCRJ6="" F S PSSDCRJ6=$O(PSSDCRJ5(PSSDCRJ6)) Q:PSSDCRJ6=""!(PSSVVHQT) D
...S PSSDCRXX="" F S PSSDCRXX=$O(PSSDCRJ5(PSSDCRJ6,PSSDCRXX)) Q:PSSDCRXX=""!(PSSVVHQT) D
....S PSSDCR4="" F S PSSDCR4=$O(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4)) Q:PSSDCR4=""!(PSSVVHQT) D
.....S PSSDCRF5="" F S PSSDCRF5=$O(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5)) Q:PSSDCRF5=""!(PSSVVHQT) D:PSSDCRF5="false"
......S PSSDCRK2=PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5)
......W:PSSDCR3 !?22 W " "_PSSDCR4_" " D Q:PSSVVHQT S PSSDCR3=1 D PAUSE Q
.......D LWRP(PSSDCRK2)
Q
;
NGCK ;
K ^TMP($J,"PSSFDBDI")
Q
;
DUP1() ;Screen out duplicates, needed if Min/max records are added back
N PSSDCRD1,PSSDCRD2,PSSDCRDF,PSSDCRD4,PSSDCRG1,PSSDCRG2
S PSSDCRDF=0
S PSSDCRD1=$P(PSSDCRN3,"^"),PSSDCRD2=$P(PSSDCR2,"^",6),PSSDCRG1=$P(PSSDCR2,"^",4),PSSDCRG2=PSSDCRD2_"^"_PSSDCRG1
S PSSDCRD4="" F S PSSDCRD4=$O(PSSDCRBS(PSSDCRD4)) Q:PSSDCRD4=""!(PSSDCRDF) D
.I $G(PSSDCRBS(PSSDCRD4,PSSDCRCO,PSSDCRD1))=PSSDCRG2 S PSSDCRDF=1
Q PSSDCRDF
;
DUP2() ;
N PSSDCRD5,PSSDCRD6,PSSDCRDG,PSSDCRD7,PSSDCRG4,PSSDCRG5
S PSSDCRDG=0
S PSSDCRD5=$P(PSSDCRN3,"^",2),PSSDCRD6=$P(PSSDCR2,"^",6),PSSDCRG4=$P(PSSDCR2,"^",4),PSSDCRG5=PSSDCRD6_"^"_PSSDCRG4
S PSSDCRD7="" F S PSSDCRD7=$O(PSSDCRWT(PSSDCRD7)) Q:PSSDCRD7=""!(PSSDCRDG) D
.I $G(PSSDCRWT(PSSDCRD7,PSSDCRCO,PSSDCRD5))=PSSDCRG5 S PSSDCRDG=1
Q PSSDCRDG
;
LWRP(PSSDCRL1) ;Print last line, check for wrapping
N PSSDCRL2,PSSDCRL3,PSSDCRL4,PSSDCRL5
S PSSDCRL2=$S($P(PSSDCRL1,"^")'="":$L($P(PSSDCRL1,"^")),1:13),PSSDCRL3=$S($P(PSSDCRL1,"^",2)'="":$L($P(PSSDCRL1,"^",2)),1:12) I $P(PSSDCRL1,"^",2)="MAINTENANCE" S PSSDCRL3=PSSDCRL3+5
S PSSDCRL4=PSSDCRL2+PSSDCRL3+$L(PSSDCR4)
W "("_$S($P(PSSDCRL1,"^",2)="":"No Dose Type",1:$P(PSSDCRL1,"^",2))_$S($P(PSSDCRL1,"^",2)="MAINTENANCE":" DOSE, ",1:", ")
I PSSDCRL4<51 W $S($P(PSSDCRL1,"^")="":"No Dose Route)",1:$P(PSSDCRL1,"^")_")") Q
D PAUSE Q:PSSVVHQT S PSSDCRL5=$L(PSSDCR4)+26 W !?PSSDCRL5,$S($P(PSSDCRL1,"^")="":"No Dose Route)",1:$P(PSSDCRL1,"^")_")")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDRDOS 15549 printed Sep 11, 2024@02:51:01 Page 2
PSSDRDOS ;BIR/RTR-Display Dosing related information for DRUG File(#50) entry ;08/20/11
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**160,173,195,178,206**;9/30/97;Build 10
+2 ;
+3 ;Reference to $$PROD0^PSNAPIS(P1,P3) supported by DBIA #2531
+4 ;Reference to $$OVRIDE^PSNAPIS(P1,P3) supported by DBIA #2531
+5 ;
EN ;
+1 NEW X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DA,DR,DLAYGO,DIDEL,%,%DT,D0,I,J,XX,D
+2 NEW PSSVVHIN,PSSVVHZR,PSSVVHND,PSSVVHN1,PSSVVHN3,PSSVVHRS,PSSVVHMT,PSSVVHOV,PSSVVHNM,PSSVVHDF,PSSVVHGC,PSSVVHDX,PSSVVHLG,PSSVVHQT,PSSVVHL3,PSSVVHL4
+3 NEW PSSVVHA1,PSSVVHA2,PSSVVHA3,PSSVVHA4,PSSVVHA5,PSSVVHA7,PSSVVHA8,PSSVVHA9,PSSVVHAR,PSSIEN,PSSVVHXX,PSSVVHPL,PSSVVHHH
+4 NEW PSSVVHL1,PSSVVHL2
+5 SET $PIECE(PSSVVHL1,"=",75)=""
+6 SET $PIECE(PSSVVHL2,"-",75)=""
EN1 ;Come back through to prompt for another drug before exiting option
+1 KILL X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT,DIC,DA,DR,DLAYGO,DIDEL,%,%DT,D0,I,J,XX,D
+2 KILL PSSVVHIN,PSSVVHZR,PSSVVHND,PSSVVHN1,PSSVVHN3,PSSVVHRS,PSSVVHMT,PSSVVHOV,PSSVVHNM,PSSVVHDF,PSSVVHGC,PSSVVHDX,PSSVVHLG,PSSVVHQT,PSSVVHL3,PSSVVHL4
+3 KILL PSSVVHA1,PSSVVHA2,PSSVVHA3,PSSVVHA4,PSSVVHA5,PSSVVHA7,PSSVVHA8,PSSVVHA9,PSSVVHAR,PSSIEN,PSSVVHXX,PSSVVHPL,PSSVVHHH
+4 WRITE !
KILL DIC,X,DTOUT,DUOUT
SET DIC="^PSDRUG("
SET DIC(0)="AEQMZ"
DO ^DIC
KILL DIC,X
IF Y<0!($DATA(DUOUT))!($DATA(DTOUT))
WRITE !
QUIT
+5 SET PSSVVHIN=+Y
+6 SET (PSSVVHDX,PSSVVHQT,PSSVVHLG)=0
SET (PSSVVHOV,PSSVVHGC,PSSVVHNM,PSSVVHDF,PSSVVHPL,PSSVVHHH)=""
+7 SET PSSVVHZR=$GET(^PSDRUG(PSSVVHIN,0))
SET PSSVVHND=$GET(^PSDRUG(PSSVVHIN,"ND"))
SET PSSVVHMT=1
+8 SET PSSVVHN1=$PIECE(PSSVVHND,"^")
SET PSSVVHN3=$PIECE(PSSVVHND,"^",3)
IF 'PSSVVHN1!('PSSVVHN3)
SET PSSVVHMT=0
+9 IF 'PSSVVHMT
SET PSSVVHLG=1
GOTO NOTM
+10 SET PSSVVHRS=$$PROD0^PSNAPIS(PSSVVHN1,PSSVVHN3)
SET PSSVVHOV=$$OVRIDE^PSNAPIS(PSSVVHN1,PSSVVHN3)
SET PSSVVHHH=$SELECT(PSSVVHOV:1,1:0)
+11 SET PSSVVHNM=$PIECE(PSSVVHRS,"^")
SET PSSVVHDF=$PIECE(PSSVVHRS,"^",2)
SET PSSVVHGC=$PIECE(PSSVVHRS,"^",7)
+12 IF PSSVVHDF
SET PSSVVHPL=0
IF $PIECE($GET(^PS(50.606,PSSVVHDF,1)),"^")
SET (PSSVVHDX,PSSVVHPL)=1
+13 SET PSSVVHLG=$$ELG
+14 ;
NOTM ;Jump to here if not matched to National Drug File
+1 WRITE @IOF
+2 SET PSSVVHL3=$LENGTH($PIECE(PSSVVHZR,"^"))
SET PSSVVHL4=$SELECT(PSSVVHGC'="":$LENGTH(PSSVVHGC),1:4)
Begin DoDot:1
+3 IF (PSSVVHL3+PSSVVHL4)<54
WRITE !?12,$PIECE(PSSVVHZR,"^")_" (GCNSEQNO: "_$SELECT(PSSVVHGC'="":PSSVVHGC,1:"None")_")"
DO PAUSE
QUIT
+4 WRITE !?12,$PIECE(PSSVVHZR,"^")
DO PAUSE
if PSSVVHQT
QUIT
+5 WRITE !?12,"(GCNSEQNO: "_$SELECT(PSSVVHGC'="":PSSVVHGC,1:"None")_")"
DO PAUSE
End DoDot:1
+6 if PSSVVHQT
GOTO EN1
+7 WRITE !,PSSVVHL1
DO PAUSE
if PSSVVHQT
GOTO EN1
+8 SET PSSVVHL3=$LENGTH(PSSVVHNM)
Begin DoDot:1
+9 IF PSSVVHL3<63
WRITE !,"VA PRODUCT NAME: "_PSSVVHNM
DO PAUSE
QUIT
+10 WRITE !,"VA PRODUCT NAME:"
DO PAUSE
if PSSVVHQT
QUIT
+11 WRITE !?2,PSSVVHNM
DO PAUSE
End DoDot:1
+12 if PSSVVHQT
GOTO EN1
+13 WRITE !,"NDF DOSAGE FORM: "_$SELECT(PSSVVHDF:$PIECE($GET(^PS(50.606,+PSSVVHDF,0)),"^"),1:"")
DO PAUSE
if PSSVVHQT
GOTO EN1
+14 WRITE !,"DEA, SPECIAL HDLG: "_$PIECE(PSSVVHZR,"^",3)_" VA DRUG CLASS: "_$PIECE(PSSVVHZR,"^",2)
DO PAUSE
if PSSVVHQT
GOTO EN1
+15 WRITE !,"EXCLUDE DOSAGE FORM FROM DOSAGE CHECKS: "
WRITE $SELECT(PSSVVHPL:"YES",PSSVVHPL=0:"NO",1:"")
DO PAUSE
if PSSVVHQT
GOTO EN1
+16 WRITE !,"OVERRIDE DOSAGE FORM DOSE CHECK EXCLUSION FOR VA PRODUCT: "
WRITE $SELECT(PSSVVHHH:"YES",PSSVVHHH=0:"NO",1:"")
DO PAUSE
if PSSVVHQT
GOTO EN1
+17 WRITE !
DO PAUSE
if PSSVVHQT
GOTO EN1
+18 WRITE !?7,"***DRUG "_$SELECT(PSSVVHLG:"NOT ",1:"")_"ELIGIBLE FOR DOSAGE CHECKS***"
DO PAUSE
if PSSVVHQT
GOTO EN1
+19 WRITE !,PSSVVHL2
DO PAUSE
if PSSVVHQT
GOTO EN1
+20 ;
+21 SET PSSVVHA1=$GET(^PSDRUG(PSSVVHIN,"DOS"))
SET PSSVVHL3=0
+22 SET PSSVVHA2=$PIECE(PSSVVHA1,"^")
SET PSSVVHA3=$PIECE(PSSVVHA1,"^",2)
IF PSSVVHA3
IF $PIECE($GET(^PS(50.607,+PSSVVHA3,0)),"^")'["/"
SET PSSVVHL3=$LENGTH($PIECE($GET(^PS(50.607,+PSSVVHA3,0)),"^"))
+23 WRITE !,"Strength: "_$SELECT($EXTRACT($GET(PSSVVHA2),1)=".":"0",1:"")_$GET(PSSVVHA2)
Begin DoDot:1
+24 IF PSSVVHA3=""
WRITE " Unit:"
DO PAUSE
QUIT
+25 IF PSSVVHL3<46
WRITE " Unit: "_$SELECT($PIECE($GET(^PS(50.607,+$GET(PSSVVHA3),0)),"^")'["/":$PIECE($GET(^(0)),"^"),1:"")
DO PAUSE
QUIT
+26 WRITE !
DO PAUSE
if PSSVVHQT
QUIT
+27 WRITE " Unit: "_$SELECT($PIECE($GET(^PS(50.607,+$GET(PSSVVHA3),0)),"^")'["/":$PIECE($GET(^(0)),"^"),1:"")
DO PAUSE
QUIT
End DoDot:1
+28 if PSSVVHQT
GOTO EN1
+29 WRITE !,"POSSIBLE DOSAGES:"
DO PAUSE
if PSSVVHQT
GOTO EN1
Begin DoDot:1
+30 FOR PSSVVHA4=0:0
SET PSSVVHA4=$ORDER(^PSDRUG(PSSVVHIN,"DOS1",PSSVVHA4))
if 'PSSVVHA4!(PSSVVHQT)
QUIT
Begin DoDot:2
+31 SET PSSVVHA5=$GET(^PSDRUG(PSSVVHIN,"DOS1",PSSVVHA4,0))
+32 WRITE !," DISPENSE UNITS PER DOSE: "
Begin DoDot:3
+33 WRITE $SELECT($EXTRACT($PIECE(PSSVVHA5,"^"),1)=".":"0",1:"")_$PIECE(PSSVVHA5,"^")
+34 SET X=$PIECE(PSSVVHA5,"^")
SET PSSIEN=PSSVVHIN
DO SET^PSSDOSLZ
SET PSSVVHXX=$GET(X)
+35 WRITE ?43,"DOSE: ",PSSVVHXX
+36 IF $LENGTH(PSSVVHXX)'>14
WRITE ?65,"PACKAGE: ",$PIECE(PSSVVHA5,U,3)
DO PAUSE
QUIT
+37 WRITE !
DO PAUSE
if PSSVVHQT
QUIT
+38 WRITE ?65,"PACKAGE: ",$PIECE(PSSVVHA5,U,3)
DO PAUSE
End DoDot:3
+39 if PSSVVHQT
QUIT
+40 WRITE !," BCMA UNITS PER DOSE: "_$SELECT($EXTRACT($PIECE(PSSVVHA5,"^",4),1)=".":"0",1:"")_$PIECE(PSSVVHA5,"^",4)
DO PAUSE
End DoDot:2
End DoDot:1
+41 if PSSVVHQT
GOTO EN1
+42 WRITE !!,"LOCAL POSSIBLE DOSAGES:"
DO PAUSE
if PSSVVHQT
GOTO EN1
Begin DoDot:1
+43 FOR PSSVVHA7=0:0
SET PSSVVHA7=$ORDER(^PSDRUG(PSSVVHIN,"DOS2",PSSVVHA7))
if 'PSSVVHA7!(PSSVVHQT)
QUIT
Begin DoDot:2
+44 SET PSSVVHA8=$GET(^PSDRUG(PSSVVHIN,"DOS2",PSSVVHA7,0))
WRITE !," LOCAL POSSIBLE DOSAGE: "
Begin DoDot:3
+45 IF $LENGTH($PIECE(PSSVVHA8,"^"))'>37
WRITE $PIECE(PSSVVHA8,"^"),?65,"PACKAGE: ",$PIECE(PSSVVHA8,"^",2)
DO PAUSE
if PSSVVHQT
QUIT
DO WXFPT(PSSVVHA8)
QUIT
+46 WRITE !,?3,$PIECE(PSSVVHA8,"^"),?65,"PACKAGE: ",$PIECE(PSSVVHA8,"^",2)
DO PAUSE
if PSSVVHQT
QUIT
DO WXFPT(PSSVVHA8)
End DoDot:3
End DoDot:2
End DoDot:1
+47 if PSSVVHQT
GOTO EN1
+48 WRITE !,PSSVVHL2
DO PAUSE
if PSSVVHQT
GOTO EN1
+49 IF $GET(PSSVVHGC)=""!(PSSVVHLG)
Begin DoDot:1
+50 WRITE !,"FDB ROUTES:"
DO PAUSE
if PSSVVHQT
QUIT
+51 WRITE !,"FDB DOSE UNITS:"
DO PAUSE
if PSSVVHQT
QUIT
+52 WRITE !,"BSA REQUIRED FOR DOSAGE CHECKS:"
DO PAUSE
if PSSVVHQT
QUIT
+53 WRITE !,"WEIGHT REQUIRED FOR DOSAGE CHECKS:"
DO PAUSE
End DoDot:1
GOTO EN1
+54 DO NGC
DO NGCK
+55 ; Clinical Effects of Drug fields
IF $PIECE($GET(^PSDRUG(PSSVVHIN,"ND")),"^",3)'=""
DO CLEFF^PSSDRDO2(PSSVVHN3)
DO PAUSE
if PSSVVHQT
QUIT
+56 GOTO EN1
+57 ;
WXFPT(PSSVVHCL) ;
+1 NEW PSSVVHC1,PSSVVHC2,PSSVVHC3,PSSVVHC4,PSSVVHC5,PSSVVHC6,PSSVVHC7
+2 SET PSSVVHC4=""
+3 SET PSSVVHC1=$PIECE(PSSVVHCL,"^",3)
SET PSSVVHC2=$PIECE(PSSVVHCL,"^",5)
SET PSSVVHC3=$PIECE(PSSVVHCL,"^",6)
+4 IF PSSVVHC2
SET PSSVVHC4=$PIECE($GET(^PS(51.24,+PSSVVHC2,0)),"^")
+5 SET PSSVVHC5=$SELECT($EXTRACT(PSSVVHC3)=".":"0",1:"")_PSSVVHC3
+6 SET PSSVVHC7=$SELECT($EXTRACT(PSSVVHC1)=".":"0",1:"")_PSSVVHC1
+7 SET PSSVVHC6=$LENGTH(PSSVVHC5)
+8 WRITE !?4,"BCMA UNITS PER DOSE: "_PSSVVHC7
DO PAUSE
if PSSVVHQT
QUIT
+9 IF PSSVVHC6<12
WRITE !?4," NUMERIC DOSE: "_PSSVVHC5,?38,"DOSE UNIT: "_PSSVVHC4
DO PAUSE
QUIT
+10 WRITE !,?4," NUMERIC DOSE: "_PSSVVHC5
DO PAUSE
if PSSVVHQT
QUIT
+11 WRITE !,?38,"DOSE UNIT: "_PSSVVHC4
DO PAUSE
+12 QUIT
+13 ;
PAUSE ;
+1 IF ($Y+5)'>IOSL
QUIT
+2 WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue, '^' to exit"
DO ^DIR
KILL DIR
IF 'Y
SET PSSVVHQT=1
QUIT
+3 WRITE @IOF
+4 QUIT
+5 ;
ELG() ;Is drug Dose Call Eligible, for matched drugs
+1 NEW PSSVVHDA
+2 SET PSSVVHDA=PSSVVHDF
+3 ;1=exempt from Dose Check, 0=not exempt from Dose check
+4 IF $PIECE(PSSVVHZR,"^",3)["S"!($EXTRACT($PIECE(PSSVVHZR,"^",2),1,2)="XA")
QUIT 1
+5 IF $GET(PSSVVHGC)=""
QUIT 1
+6 IF $GET(PSSVVHDA)'>0
IF $PIECE($GET(^PSDRUG(PSSVVHIN,2)),"^")
SET PSSVVHDA=$PIECE($GET(^PS(50.7,+$PIECE($GET(^PSDRUG(PSSVVHIN,2)),"^"),0)),"^",2)
IF PSSVVHDA
IF $PIECE($GET(^PS(50.606,+$GET(PSSVVHDA),1)),"^")
SET PSSVVHDX=1
+7 IF PSSVVHOV=""!('$GET(PSSVVHDA))!($PIECE($GET(^PS(50.606,+$GET(PSSVVHDA),1)),"^")="")
QUIT 0
+8 IF $PIECE($GET(^PS(50.606,+$GET(PSSVVHDA),1)),"^")
IF 'PSSVVHOV
QUIT 1
+9 IF '$PIECE($GET(^PS(50.606,+$GET(PSSVVHDA),1)),"^")
IF PSSVVHOV
QUIT 1
+10 QUIT 0
+11 ;
NGC ;Print First Databank data from Dosing records
+1 NEW PSSDCR1,PSSDCR2,PSSDCR3,PSSDCR4,PSSDCR5,PSSDCR6,PSSDCR7,PSSDCR8,PSSDCR9,PSSDCRN3,PSSDCRVL,PSSDCRMR,PSSDCRUN,PSSDCRWT,PSSDCRBS,PSSDCRCO,PSSDCRF1,PSSDCRF2,PSSDCRF3,PSSDCRF4,PSSDCRF5,PSSDCRX1,PSSDCRX2,PSSDCRXX,PSSDCRK1,PSSDCRK2
+2 NEW PSSDCRJ1,PSSDCRJ2,PSSDCRJ3,PSSDCRJ4,PSSDCRJ5,PSSDCRJ6
+3 DO NGCK
+4 DO EN^PSSFDBDI(PSSVVHGC,.PSSDCRVL)
+5 IF $PIECE($GET(PSSDCRVL(0)),"^")=-1
Begin DoDot:1
+6 WRITE !,"Vendor database cannot be reached. FDB Dosing information could not be"
DO PAUSE
if PSSVVHQT
QUIT
+7 WRITE !,"retrieved at this time."
DO PAUSE
End DoDot:1
QUIT
+8 ;
+9 ;set arrays used for printing from doseRanges records
+10 SET (PSSDCRX1,PSSDCRX2)=1
+11 SET PSSVVHGC=+PSSVVHGC
+12 SET PSSDCR1=""
FOR
SET PSSDCR1=$ORDER(^TMP($JOB,"PSSFDBDI",PSSVVHGC,"doseRanges",PSSDCR1))
if PSSDCR1=""
QUIT
Begin DoDot:1
+13 SET PSSDCR2=$GET(^TMP($JOB,"PSSFDBDI",PSSVVHGC,"doseRanges",PSSDCR1,1,0))
if $PIECE(PSSDCR2,"^",4)'="SINGLE DOSE"&($PIECE(PSSDCR2,"^",4)'="MAINTENANCE")
QUIT
if $PIECE(PSSDCR2,"^",6)'=""
SET PSSDCRMR($PIECE(PSSDCR2,"^",6))=""
+14 SET PSSDCR5=$GET(^TMP($JOB,"PSSFDBDI",PSSVVHGC,"doseRanges",PSSDCR1,5,0))
+15 SET PSSDCR6=$GET(^TMP($JOB,"PSSFDBDI",PSSVVHGC,"doseRanges",PSSDCR1,6,0))
+16 SET PSSDCR7=$GET(^TMP($JOB,"PSSFDBDI",PSSVVHGC,"doseRanges",PSSDCR1,7,0))
+17 SET PSSDCRN3=$GET(^TMP($JOB,"PSSFDBDI",PSSVVHGC,"doseRanges",PSSDCR1,3,0))
+18 FOR PSSDCR8=2,4,6,8
Begin DoDot:2
+19 if $PIECE(PSSDCR5,"^",PSSDCR8)'=""
SET PSSDCRUN($PIECE($PIECE(PSSDCR5,"^",PSSDCR8),"/"))=""
if $PIECE(PSSDCR6,"^",PSSDCR8)'=""
SET PSSDCRUN($PIECE($PIECE(PSSDCR6,"^",PSSDCR8),"/"))=""
End DoDot:2
+20 FOR PSSDCR8=2,4
Begin DoDot:2
+21 if $PIECE(PSSDCR7,"^",PSSDCR8)'=""
SET PSSDCRUN($PIECE($PIECE(PSSDCR7,"^",PSSDCR8),"/"))=""
End DoDot:2
+22 IF $PIECE(PSSDCR2,"^",7)'=""
IF $PIECE(PSSDCR2,"^",8)'=""
SET PSSDCRCO=$PIECE(PSSDCR2,"^",7)_"-"_$PIECE(PSSDCR2,"^",8)
Begin DoDot:2
+23 IF $PIECE(PSSDCRN3,"^")="true"!($PIECE(PSSDCRN3,"^")="false")
IF '$$DUP1
SET PSSDCRBS(PSSDCRX1,PSSDCRCO,$PIECE(PSSDCRN3,"^"))=$PIECE(PSSDCR2,"^",6)_"^"_$PIECE(PSSDCR2,"^",4)
SET PSSDCRX1=PSSDCRX1+1
+24 IF $PIECE(PSSDCRN3,"^",2)="true"!($PIECE(PSSDCRN3,"^",2)="false")
IF '$$DUP2
SET PSSDCRWT(PSSDCRX2,PSSDCRCO,$PIECE(PSSDCRN3,"^",2))=$PIECE(PSSDCR2,"^",6)_"^"_$PIECE(PSSDCR2,"^",4)
SET PSSDCRX2=PSSDCRX2+1
End DoDot:2
End DoDot:1
+25 ;
+26 ;Removed all Min/Max Dosing records per CR 5781, CR 5783 and CCR 5778
+27 WRITE !,"FDB ROUTES: "
SET PSSDCR3=0
Begin DoDot:1
+28 SET PSSDCR4=""
FOR
SET PSSDCR4=$ORDER(PSSDCRMR(PSSDCR4))
if PSSDCR4=""!(PSSVVHQT)
QUIT
Begin DoDot:2
+29 IF 'PSSDCR3
WRITE PSSDCR4
SET PSSDCR3=1
DO PAUSE
QUIT
+30 WRITE !?12,PSSDCR4
DO PAUSE
End DoDot:2
End DoDot:1
+31 IF PSSVVHQT
QUIT
+32 ;
+33 WRITE !,"FDB DOSE UNITS: "
SET PSSDCR3=0
Begin DoDot:1
+34 SET PSSDCR4=""
FOR
SET PSSDCR4=$ORDER(PSSDCRUN(PSSDCR4))
if PSSDCR4=""!(PSSVVHQT)
QUIT
Begin DoDot:2
+35 IF 'PSSDCR3
WRITE PSSDCR4
SET PSSDCR3=1
DO PAUSE
QUIT
+36 WRITE !?16,PSSDCR4
DO PAUSE
End DoDot:2
End DoDot:1
+37 IF PSSVVHQT
QUIT
+38 ;
+39 ;Write BSA and WT required data
+40 ;If all Age ranges under BSA or WT, are the same do not list individual age ranges
+41 ;When listing Age ranges under BSA or WT, then within that Yes or No, if 2 or more and ranges exist, and one or more has
+42 ;a route associated with it, do not show the age range that does not have a route. Other than that, duplicates are not screened out.
+43 SET (PSSDCRF3,PSSDCRF4)=""
Begin DoDot:1
+44 SET PSSDCRXX=""
FOR
SET PSSDCRXX=$ORDER(PSSDCRBS(PSSDCRXX))
if PSSDCRXX=""!(PSSDCRF4)
QUIT
Begin DoDot:2
+45 SET PSSDCRF1=""
FOR
SET PSSDCRF1=$ORDER(PSSDCRBS(PSSDCRXX,PSSDCRF1))
if PSSDCRF1=""!(PSSDCRF4)
QUIT
Begin DoDot:3
+46 SET PSSDCRF2=""
FOR
SET PSSDCRF2=$ORDER(PSSDCRBS(PSSDCRXX,PSSDCRF1,PSSDCRF2))
if PSSDCRF2=""!(PSSDCRF4)
QUIT
Begin DoDot:4
+47 IF PSSDCRF3=""
SET PSSDCRF3=PSSDCRF2
QUIT
+48 IF PSSDCRF3'=PSSDCRF2
SET PSSDCRF4=1
QUIT
+49 SET PSSDCRF3=PSSDCRF2
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+50 WRITE !,"BSA REQUIRED FOR DOSAGE CHECKS:"
Begin DoDot:1
+51 IF 'PSSDCRF4
WRITE $SELECT(PSSDCRF3="true":" YES",PSSDCRF3="false":" NO",1:"")
DO PAUSE
QUIT
+52 ;Resort by starting age for printing
+53 KILL PSSDCRJ1,PSSDCRJ2,PSSDCRJ3,PSSDCRJ4,PSSDCRJ5,PSSDCRJ6
+54 FOR PSSDCRJ1=1:1
if '$DATA(PSSDCRBS(PSSDCRJ1))
QUIT
SET PSSDCRJ2=""
FOR
SET PSSDCRJ2=$ORDER(PSSDCRBS(PSSDCRJ1,PSSDCRJ2))
if PSSDCRJ2=""
QUIT
Begin DoDot:2
+55 SET PSSDCRJ3=""
FOR
SET PSSDCRJ3=$ORDER(PSSDCRBS(PSSDCRJ1,PSSDCRJ2,PSSDCRJ3))
if PSSDCRJ3=""
QUIT
SET PSSDCRJ4=$PIECE(PSSDCRJ2,"-")
Begin DoDot:3
+56 SET PSSDCRJ5(PSSDCRJ4,PSSDCRJ1,PSSDCRJ2,PSSDCRJ3)=PSSDCRBS(PSSDCRJ1,PSSDCRJ2,PSSDCRJ3)
End DoDot:3
End DoDot:2
+57 WRITE !?2,"YES for Age in Days:"
SET PSSDCR3=0
Begin DoDot:2
+58 SET PSSDCRJ6=""
FOR
SET PSSDCRJ6=$ORDER(PSSDCRJ5(PSSDCRJ6))
if PSSDCRJ6=""!(PSSVVHQT)
QUIT
Begin DoDot:3
+59 SET PSSDCRXX=""
FOR
SET PSSDCRXX=$ORDER(PSSDCRJ5(PSSDCRJ6,PSSDCRXX))
if PSSDCRXX=""!(PSSVVHQT)
QUIT
Begin DoDot:4
+60 SET PSSDCR4=""
FOR
SET PSSDCR4=$ORDER(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4))
if PSSDCR4=""!(PSSVVHQT)
QUIT
Begin DoDot:5
+61 SET PSSDCRF5=""
FOR
SET PSSDCRF5=$ORDER(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5))
if PSSDCRF5=""!(PSSVVHQT)
QUIT
if PSSDCRF5="true"
Begin DoDot:6
+62 SET PSSDCRK1=PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5)
+63 if PSSDCR3
WRITE !?22
WRITE " "_PSSDCR4_" "
Begin DoDot:7
+64 DO LWRP(PSSDCRK1)
End DoDot:7
if PSSVVHQT
QUIT
SET PSSDCR3=1
DO PAUSE
QUIT
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+65 if PSSVVHQT
QUIT
+66 WRITE !?3,"NO for Age in Days:"
SET PSSDCR3=0
Begin DoDot:2
+67 SET PSSDCRJ6=""
FOR
SET PSSDCRJ6=$ORDER(PSSDCRJ5(PSSDCRJ6))
if PSSDCRJ6=""!(PSSVVHQT)
QUIT
Begin DoDot:3
+68 SET PSSDCRXX=""
FOR
SET PSSDCRXX=$ORDER(PSSDCRJ5(PSSDCRJ6,PSSDCRXX))
if PSSDCRXX=""!(PSSVVHQT)
QUIT
Begin DoDot:4
+69 SET PSSDCR4=""
FOR
SET PSSDCR4=$ORDER(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4))
if PSSDCR4=""!(PSSVVHQT)
QUIT
Begin DoDot:5
+70 SET PSSDCRF5=""
FOR
SET PSSDCRF5=$ORDER(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5))
if PSSDCRF5=""!(PSSVVHQT)
QUIT
if PSSDCRF5="false"
Begin DoDot:6
+71 SET PSSDCRK2=PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5)
+72 if PSSDCR3
WRITE !?22
WRITE " "_PSSDCR4_" "
Begin DoDot:7
+73 DO LWRP(PSSDCRK2)
End DoDot:7
if PSSVVHQT
QUIT
SET PSSDCR3=1
DO PAUSE
QUIT
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+74 IF PSSVVHQT
QUIT
+75 ;
+76 SET (PSSDCRF3,PSSDCRF4)=""
Begin DoDot:1
+77 SET PSSDCRXX=""
FOR
SET PSSDCRXX=$ORDER(PSSDCRWT(PSSDCRXX))
if PSSDCRXX=""!(PSSDCRF4)
QUIT
Begin DoDot:2
+78 SET PSSDCRF1=""
FOR
SET PSSDCRF1=$ORDER(PSSDCRWT(PSSDCRXX,PSSDCRF1))
if PSSDCRF1=""!(PSSDCRF4)
QUIT
Begin DoDot:3
+79 SET PSSDCRF2=""
FOR
SET PSSDCRF2=$ORDER(PSSDCRWT(PSSDCRXX,PSSDCRF1,PSSDCRF2))
if PSSDCRF2=""!(PSSDCRF4)
QUIT
Begin DoDot:4
+80 IF PSSDCRF3=""
SET PSSDCRF3=PSSDCRF2
QUIT
+81 IF PSSDCRF3'=PSSDCRF2
SET PSSDCRF4=1
QUIT
+82 SET PSSDCRF3=PSSDCRF2
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+83 WRITE !,"WEIGHT REQUIRED FOR DOSAGE CHECKS:"
Begin DoDot:1
+84 IF 'PSSDCRF4
WRITE $SELECT(PSSDCRF3="true":" YES",PSSDCRF3="false":" NO",1:"")
DO PAUSE
QUIT
+85 ;Resort by starting age for printing
+86 KILL PSSDCRJ1,PSSDCRJ2,PSSDCRJ3,PSSDCRJ4,PSSDCRJ5,PSSDCRJ6
+87 FOR PSSDCRJ1=1:1
if '$DATA(PSSDCRWT(PSSDCRJ1))
QUIT
SET PSSDCRJ2=""
FOR
SET PSSDCRJ2=$ORDER(PSSDCRWT(PSSDCRJ1,PSSDCRJ2))
if PSSDCRJ2=""
QUIT
Begin DoDot:2
+88 SET PSSDCRJ3=""
FOR
SET PSSDCRJ3=$ORDER(PSSDCRWT(PSSDCRJ1,PSSDCRJ2,PSSDCRJ3))
if PSSDCRJ3=""
QUIT
SET PSSDCRJ4=$PIECE(PSSDCRJ2,"-")
Begin DoDot:3
+89 SET PSSDCRJ5(PSSDCRJ4,PSSDCRJ1,PSSDCRJ2,PSSDCRJ3)=PSSDCRWT(PSSDCRJ1,PSSDCRJ2,PSSDCRJ3)
End DoDot:3
End DoDot:2
+90 WRITE !?2,"YES for Age in Days:"
SET PSSDCR3=0
Begin DoDot:2
+91 SET PSSDCRJ6=""
FOR
SET PSSDCRJ6=$ORDER(PSSDCRJ5(PSSDCRJ6))
if PSSDCRJ6=""!(PSSVVHQT)
QUIT
Begin DoDot:3
+92 SET PSSDCRXX=""
FOR
SET PSSDCRXX=$ORDER(PSSDCRJ5(PSSDCRJ6,PSSDCRXX))
if PSSDCRXX=""!(PSSVVHQT)
QUIT
Begin DoDot:4
+93 SET PSSDCR4=""
FOR
SET PSSDCR4=$ORDER(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4))
if PSSDCR4=""!(PSSVVHQT)
QUIT
Begin DoDot:5
+94 SET PSSDCRF5=""
FOR
SET PSSDCRF5=$ORDER(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5))
if PSSDCRF5=""!(PSSVVHQT)
QUIT
if PSSDCRF5="true"
Begin DoDot:6
+95 SET PSSDCRK1=PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5)
+96 if PSSDCR3
WRITE !?22
WRITE " "_PSSDCR4_" "
Begin DoDot:7
+97 DO LWRP(PSSDCRK1)
End DoDot:7
if PSSVVHQT
QUIT
SET PSSDCR3=1
DO PAUSE
QUIT
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+98 if PSSVVHQT
QUIT
+99 WRITE !?3,"NO for Age in Days:"
SET PSSDCR3=0
Begin DoDot:2
+100 SET PSSDCRJ6=""
FOR
SET PSSDCRJ6=$ORDER(PSSDCRJ5(PSSDCRJ6))
if PSSDCRJ6=""!(PSSVVHQT)
QUIT
Begin DoDot:3
+101 SET PSSDCRXX=""
FOR
SET PSSDCRXX=$ORDER(PSSDCRJ5(PSSDCRJ6,PSSDCRXX))
if PSSDCRXX=""!(PSSVVHQT)
QUIT
Begin DoDot:4
+102 SET PSSDCR4=""
FOR
SET PSSDCR4=$ORDER(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4))
if PSSDCR4=""!(PSSVVHQT)
QUIT
Begin DoDot:5
+103 SET PSSDCRF5=""
FOR
SET PSSDCRF5=$ORDER(PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5))
if PSSDCRF5=""!(PSSVVHQT)
QUIT
if PSSDCRF5="false"
Begin DoDot:6
+104 SET PSSDCRK2=PSSDCRJ5(PSSDCRJ6,PSSDCRXX,PSSDCR4,PSSDCRF5)
+105 if PSSDCR3
WRITE !?22
WRITE " "_PSSDCR4_" "
Begin DoDot:7
+106 DO LWRP(PSSDCRK2)
End DoDot:7
if PSSVVHQT
QUIT
SET PSSDCR3=1
DO PAUSE
QUIT
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+107 QUIT
+108 ;
NGCK ;
+1 KILL ^TMP($JOB,"PSSFDBDI")
+2 QUIT
+3 ;
DUP1() ;Screen out duplicates, needed if Min/max records are added back
+1 NEW PSSDCRD1,PSSDCRD2,PSSDCRDF,PSSDCRD4,PSSDCRG1,PSSDCRG2
+2 SET PSSDCRDF=0
+3 SET PSSDCRD1=$PIECE(PSSDCRN3,"^")
SET PSSDCRD2=$PIECE(PSSDCR2,"^",6)
SET PSSDCRG1=$PIECE(PSSDCR2,"^",4)
SET PSSDCRG2=PSSDCRD2_"^"_PSSDCRG1
+4 SET PSSDCRD4=""
FOR
SET PSSDCRD4=$ORDER(PSSDCRBS(PSSDCRD4))
if PSSDCRD4=""!(PSSDCRDF)
QUIT
Begin DoDot:1
+5 IF $GET(PSSDCRBS(PSSDCRD4,PSSDCRCO,PSSDCRD1))=PSSDCRG2
SET PSSDCRDF=1
End DoDot:1
+6 QUIT PSSDCRDF
+7 ;
DUP2() ;
+1 NEW PSSDCRD5,PSSDCRD6,PSSDCRDG,PSSDCRD7,PSSDCRG4,PSSDCRG5
+2 SET PSSDCRDG=0
+3 SET PSSDCRD5=$PIECE(PSSDCRN3,"^",2)
SET PSSDCRD6=$PIECE(PSSDCR2,"^",6)
SET PSSDCRG4=$PIECE(PSSDCR2,"^",4)
SET PSSDCRG5=PSSDCRD6_"^"_PSSDCRG4
+4 SET PSSDCRD7=""
FOR
SET PSSDCRD7=$ORDER(PSSDCRWT(PSSDCRD7))
if PSSDCRD7=""!(PSSDCRDG)
QUIT
Begin DoDot:1
+5 IF $GET(PSSDCRWT(PSSDCRD7,PSSDCRCO,PSSDCRD5))=PSSDCRG5
SET PSSDCRDG=1
End DoDot:1
+6 QUIT PSSDCRDG
+7 ;
LWRP(PSSDCRL1) ;Print last line, check for wrapping
+1 NEW PSSDCRL2,PSSDCRL3,PSSDCRL4,PSSDCRL5
+2 SET PSSDCRL2=$SELECT($PIECE(PSSDCRL1,"^")'="":$LENGTH($PIECE(PSSDCRL1,"^")),1:13)
SET PSSDCRL3=$SELECT($PIECE(PSSDCRL1,"^",2)'="":$LENGTH($PIECE(PSSDCRL1,"^",2)),1:12)
IF $PIECE(PSSDCRL1,"^",2)="MAINTENANCE"
SET PSSDCRL3=PSSDCRL3+5
+3 SET PSSDCRL4=PSSDCRL2+PSSDCRL3+$LENGTH(PSSDCR4)
+4 WRITE "("_$SELECT($PIECE(PSSDCRL1,"^",2)="":"No Dose Type",1:$PIECE(PSSDCRL1,"^",2))_$SELECT($PIECE(PSSDCRL1,"^",2)="MAINTENANCE":" DOSE, ",1:", ")
+5 IF PSSDCRL4<51
WRITE $SELECT($PIECE(PSSDCRL1,"^")="":"No Dose Route)",1:$PIECE(PSSDCRL1,"^")_")")
QUIT
+6 DO PAUSE
if PSSVVHQT
QUIT
SET PSSDCRL5=$LENGTH(PSSDCR4)+26
WRITE !?PSSDCRL5,$SELECT($PIECE(PSSDCRL1,"^")="":"No Dose Route)",1:$PIECE(PSSDCRL1,"^")_")")
+7 QUIT
+8 ;
