PSSDRDO2 ;BIR/LE-Display Dosing related information for DRUG File(#50) entry ;07/14/15
;;1.0;PHARMACY DATA MANAGEMENT;**195**;9/30/97;Build 25
;
;Reference to DATA^PSN50P68 supported by DBIA 4545
;
;called from PSSDRDOS
CLEFF(PSSVAPRD) ;Retrieve and write Clinical Effects of Drug fields
;input: PSSVAPRD = IEN for VA Product file (#50.68)
;
; Clinical Effects of Drug fields
Q:'$G(PSSVAPRD)
K ^TMP($J,"PSSVAPR")
D DATA^PSN50P68(PSSVAPRD,"","PSSVAPR") ;using the PRE encapuslation API
N PSSII,PSSIII,PSSPKG,PSSPKG,PSSOMIT,PSSEXLMT,PSSCLEF,PSSNIEN
S PSSNIEN=PSSVAPRD
I $D(^TMP($J,"PSSVAPR",PSSNIEN)) D
.S (PSSII,PSSIII)=0
.F S PSSII=$O(^TMP($J,"PSSVAPR",PSSNIEN,108,PSSII)) Q:PSSII="" D
..S (PSSPKG,PSSOMIT,PSSEXLMT)=""
..F S PSSIII=$O(^TMP($J,"PSSVAPR",PSSNIEN,108,PSSII,PSSIII)) Q:PSSIII="" D
...S:PSSIII=.01 PSSPKG=^TMP($J,"PSSVAPR",PSSNIEN,108,PSSII,PSSIII)
...S:PSSIII=1 PSSOMIT=^TMP($J,"PSSVAPR",PSSNIEN,108,PSSII,PSSIII)
...S:PSSIII=2 PSSEXLMT=^TMP($J,"PSSVAPR",PSSNIEN,108,PSSII,PSSIII)
..S:PSSPKG'="" PSSCLEF(PSSPKG)=PSSOMIT_"^"_PSSEXLMT
;
W !!,"CLINICAL EFFECT DURATION: ",$S($D(^TMP($J,"PSSVAPR",PSSNIEN,108)):"YES",1:"NO")
;If package IO is defined only show it, otherwise show all packages
I $D(PSSCLEF("IO")) S PSSPKG="IO" D CLEFFS,CLEFFW(PSSPKG,PSSOMIT,PSSEXLMT) Q
S PSSPKG="" F S PSSPKG=$O(PSSCLEF(PSSPKG)) Q:PSSPKG="" D
.D CLEFFS,CLEFFW(PSSPKG,PSSOMIT,PSSEXLMT)
Q
;
CLEFFS ;
S (PSSOMIT,PSSEXLMT)="",PSSOMIT=$P(PSSCLEF(PSSPKG),"^"),PSSEXLMT=$P(PSSCLEF(PSSPKG),"^",2)
Q
;
CLEFFW(PSSPKG,PSSOMIT,PSSEXLMT) ;
N PSSPACK2 S PSSPACK2=""
S (PSSOMIT,PSSEXLMT)="",PSSOMIT=$P(PSSCLEF(PSSPKG),"^"),PSSEXLMT=$P(PSSCLEF(PSSPKG),"^",2)
N PSSPACK2 S PSSPACK2=""
S PSSPACK2=$S(PSSPKG="I":"INPATIENT",PSSPKG="O":"OUTPATIENT",PSSPKG="IO":"BOTH INPATIENT AND OUTPATIENT",1:"")
W !?3,PSSPACK2," DURATION LIMIT: " W:PSSOMIT=0 PSSEXLMT
W !?6,"OMIT EXP/DC ORDER CHECK: ",$S(PSSOMIT=1:"YES",PSSOMIT=0:"NO",1:"")
K ^TMP($J,"PSSVAPR")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDRDO2 2024 printed Sep 23, 2025@20:06:40 Page 2
PSSDRDO2 ;BIR/LE-Display Dosing related information for DRUG File(#50) entry ;07/14/15
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**195**;9/30/97;Build 25
+2 ;
+3 ;Reference to DATA^PSN50P68 supported by DBIA 4545
+4 ;
+5 ;called from PSSDRDOS
CLEFF(PSSVAPRD) ;Retrieve and write Clinical Effects of Drug fields
+1 ;input: PSSVAPRD = IEN for VA Product file (#50.68)
+2 ;
+3 ; Clinical Effects of Drug fields
+4 if '$GET(PSSVAPRD)
QUIT
+5 KILL ^TMP($JOB,"PSSVAPR")
+6 ;using the PRE encapuslation API
DO DATA^PSN50P68(PSSVAPRD,"","PSSVAPR")
+7 NEW PSSII,PSSIII,PSSPKG,PSSPKG,PSSOMIT,PSSEXLMT,PSSCLEF,PSSNIEN
+8 SET PSSNIEN=PSSVAPRD
+9 IF $DATA(^TMP($JOB,"PSSVAPR",PSSNIEN))
Begin DoDot:1
+10 SET (PSSII,PSSIII)=0
+11 FOR
SET PSSII=$ORDER(^TMP($JOB,"PSSVAPR",PSSNIEN,108,PSSII))
if PSSII=""
QUIT
Begin DoDot:2
+12 SET (PSSPKG,PSSOMIT,PSSEXLMT)=""
+13 FOR
SET PSSIII=$ORDER(^TMP($JOB,"PSSVAPR",PSSNIEN,108,PSSII,PSSIII))
if PSSIII=""
QUIT
Begin DoDot:3
+14 if PSSIII=.01
SET PSSPKG=^TMP($JOB,"PSSVAPR",PSSNIEN,108,PSSII,PSSIII)
+15 if PSSIII=1
SET PSSOMIT=^TMP($JOB,"PSSVAPR",PSSNIEN,108,PSSII,PSSIII)
+16 if PSSIII=2
SET PSSEXLMT=^TMP($JOB,"PSSVAPR",PSSNIEN,108,PSSII,PSSIII)
End DoDot:3
+17 if PSSPKG'=""
SET PSSCLEF(PSSPKG)=PSSOMIT_"^"_PSSEXLMT
End DoDot:2
End DoDot:1
+18 ;
+19 WRITE !!,"CLINICAL EFFECT DURATION: ",$SELECT($DATA(^TMP($JOB,"PSSVAPR",PSSNIEN,108)):"YES",1:"NO")
+20 ;If package IO is defined only show it, otherwise show all packages
+21 IF $DATA(PSSCLEF("IO"))
SET PSSPKG="IO"
DO CLEFFS
DO CLEFFW(PSSPKG,PSSOMIT,PSSEXLMT)
QUIT
+22 SET PSSPKG=""
FOR
SET PSSPKG=$ORDER(PSSCLEF(PSSPKG))
if PSSPKG=""
QUIT
Begin DoDot:1
+23 DO CLEFFS
DO CLEFFW(PSSPKG,PSSOMIT,PSSEXLMT)
End DoDot:1
+24 QUIT
+25 ;
CLEFFS ;
+1 SET (PSSOMIT,PSSEXLMT)=""
SET PSSOMIT=$PIECE(PSSCLEF(PSSPKG),"^")
SET PSSEXLMT=$PIECE(PSSCLEF(PSSPKG),"^",2)
+2 QUIT
+3 ;
CLEFFW(PSSPKG,PSSOMIT,PSSEXLMT) ;
+1 NEW PSSPACK2
SET PSSPACK2=""
+2 SET (PSSOMIT,PSSEXLMT)=""
SET PSSOMIT=$PIECE(PSSCLEF(PSSPKG),"^")
SET PSSEXLMT=$PIECE(PSSCLEF(PSSPKG),"^",2)
+3 NEW PSSPACK2
SET PSSPACK2=""
+4 SET PSSPACK2=$SELECT(PSSPKG="I":"INPATIENT",PSSPKG="O":"OUTPATIENT",PSSPKG="IO":"BOTH INPATIENT AND OUTPATIENT",1:"")
+5 WRITE !?3,PSSPACK2," DURATION LIMIT: "
if PSSOMIT=0
WRITE PSSEXLMT
+6 WRITE !?6,"OMIT EXP/DC ORDER CHECK: ",$SELECT(PSSOMIT=1:"YES",PSSOMIT=0:"NO",1:"")
+7 KILL ^TMP($JOB,"PSSVAPR")
+8 QUIT
+9 ;
