PSNCLEHW ;BIR/LE-CLINICAL EFFECTS & HAZARDOUS WASTE DISPLAY ; 07/02/03 14:01
;;4.0;NATIONAL DRUG FILE;**396**; 30 Oct 98;Build 190
;
Q
;
;This routine is called by PSNLOOK, PSNACT and PSNDRDOS routes for display
;of hazardous waste and clinical effects fields
;
CLEFF(VAPRD,QUIT) ;Display Clinical Effects fields
;Input: VAPRD - VA PRODUCT (#50.68) IEN
I '$G(QUIT) S QUIT=0
Q:QUIT QUIT
N X,Y,II,III,PSNPKG,PSNPKG2,PSNOMIT,PSNEXLMT,PSNCLEF,PSNCLEFA,QUIT,PSNHWQT
D GETS^DIQ(50.68,VAPRD_",","108*","EI","PSNCLEFA")
W !!,"CLINICAL EFFECT DURATION: ",$S($D(PSNCLEFA):"YES",1:"NO")
Q:'$D(PSNCLEFA)
S (II,III,QUIT)=0
F S II=$O(PSNCLEFA(50.68108,II)) Q:II="" F S III=$O(PSNCLEFA(50.68108,II,III)) Q:III="" D
.S PSNPKG=$G(PSNCLEFA(50.68108,II,.01,"I")),PSNOMIT=$G(PSNCLEFA(50.68108,II,1,"E"))
.S PSNEXLMT=$G(PSNCLEFA(50.68108,II,2,"E")) S:PSNPKG'="" PSNCLEF(PSNPKG)=PSNOMIT_"^"_PSNEXLMT
;If package IO is defined only show it, otherwise show all packages
I $D(PSNCLEF("IO")) S PSNPKG="IO" D CLEFFS,CLEFFW(PSNPKG,PSNOMIT,PSNEXLMT) Q QUIT
S PSNPKG="" F S PSNPKG=$O(PSNCLEF(PSNPKG)) Q:PSNPKG="" D Q:QUIT
.D CLEFFS,CLEFFW(PSNPKG,PSNOMIT,PSNEXLMT) S:QUIT PSNHWQT=1
Q QUIT
;
CLEFFS ;
S (PSNOMIT,PSNEXLMT)="",PSNOMIT=$P(PSNCLEF(PSNPKG),"^"),PSNEXLMT=$P(PSNCLEF(PSNPKG),"^",2)
Q
;
CLEFFW(PSNPKG,PSNOMIT,PSNEXLMT) ;
N PSNPACK2 S PSNPACK2=""
S PSNPACK2=$S(PSNPKG="I":"INPATIENT",PSNPKG="O":"OUTPATIENT",PSNPKG="IO":"BOTH INPATIENT AND OUTPATIENT",1:"")
W !?3,PSNPACK2," DURATION LIMIT: " W:PSNOMIT="NO" PSNEXLMT W !?6,"OMIT EXP/DC ORDER CHECK: ",PSNOMIT
D:($Y+5)>IOSL HANG
Q
;
HAZWASTE(VAPRD,QUIT) ;Display Hazardous Waste fields
;Input: VAPRD - VA PRODUCT (#50.68) IEN
;returns PSNHWAT = 1 for quit or 0 don't quit.
I '$G(QUIT) S QUIT=0
Q:QUIT QUIT
N HAZARY,HAZHTDX,PSNHWQT
W !
D:($Y+5)>IOSL HANG G END:QUIT
D GETS^DIQ(50.68,VAPRD_",","101;102;103;104;105","EI","HAZARY")
S HAZHTDX=0
I $G(HAZARY(50.68,VAPRD_",",102,"I"))=1 S HAZHTDX=1
W:$G(HAZARY(50.68,VAPRD_",",101,"E"))'="" !,"Hazardous to Handle: ",HAZARY(50.68,VAPRD_",",101,"E")
D:($Y+5)>IOSL HANG G END:QUIT
W:$G(HAZARY(50.68,VAPRD_",",102,"E"))'="" !,"Hazardous to Dispose: ",HAZARY(50.68,VAPRD_",",102,"E")
D:($Y+5)>IOSL HANG G END:QUIT
W:$G(HAZARY(50.68,VAPRD_",",103,"E"))'=""&(HAZHTDX) !," Primary EPA Code: ",HAZARY(50.68,VAPRD_",",103,"E")
D:($Y+5)>IOSL HANG G END:QUIT
W:$G(HAZARY(50.68,VAPRD_",",104,"E"))'=""&(HAZHTDX) !," Waste Sort Code: ",HAZARY(50.68,VAPRD_",",104,"E")
I QUIT S PSNHWQT=1 G END:QUIT
N HAZWCNT,HAZWCNT2,X,DIWL,DIWR,DIWF
K ^UTILITY($J,"W")
S HAZWCNT2=1,HAZWCNT=0,DIWL=1,DIWR=50
F S HAZWCNT=$O(HAZARY(50.68,VAPRD_",",105,HAZWCNT)) Q:'HAZWCNT D
. S X="",X=HAZARY(50.68,VAPRD_",",105,HAZWCNT) D ^DIWP
S HAZWCNT=0 F HAZWCNT=0:0 S HAZWCNT=$O(^UTILITY($J,"W",DIWL,HAZWCNT)) Q:'HAZWCNT D
.I HAZWCNT2=1 W !," DOT Shipping Name: "
.I HAZWCNT2>1 W !," "
.W $G(^UTILITY($J,"W",DIWL,HAZWCNT,0)) S HAZWCNT2=2
K ^UTILITY($J,"W")
;W:$G(HAZARY(50.68,VAPRD_",",105,"E"))'=""&(HAZHTDX) !," DOT Shipping Name: ",HAZARY(50.68,VAPRD_",",105,"E")
W !
K HAZARY,HAZHTDX
END ;
Q QUIT
;
HANG K DIR S DIR(0)="E",DIR("A")="Press return to continue or '^' to exit" D ^DIR W @IOF S $X=0 S:Y'=1 QUIT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNCLEHW 3347 printed Dec 13, 2024@02:23:45 Page 2
PSNCLEHW ;BIR/LE-CLINICAL EFFECTS & HAZARDOUS WASTE DISPLAY ; 07/02/03 14:01
+1 ;;4.0;NATIONAL DRUG FILE;**396**; 30 Oct 98;Build 190
+2 ;
+3 QUIT
+4 ;
+5 ;This routine is called by PSNLOOK, PSNACT and PSNDRDOS routes for display
+6 ;of hazardous waste and clinical effects fields
+7 ;
CLEFF(VAPRD,QUIT) ;Display Clinical Effects fields
+1 ;Input: VAPRD - VA PRODUCT (#50.68) IEN
+2 IF '$GET(QUIT)
SET QUIT=0
+3 if QUIT
QUIT QUIT
+4 NEW X,Y,II,III,PSNPKG,PSNPKG2,PSNOMIT,PSNEXLMT,PSNCLEF,PSNCLEFA,QUIT,PSNHWQT
+5 DO GETS^DIQ(50.68,VAPRD_",","108*","EI","PSNCLEFA")
+6 WRITE !!,"CLINICAL EFFECT DURATION: ",$SELECT($DATA(PSNCLEFA):"YES",1:"NO")
+7 if '$DATA(PSNCLEFA)
QUIT
+8 SET (II,III,QUIT)=0
+9 FOR
SET II=$ORDER(PSNCLEFA(50.68108,II))
if II=""
QUIT
FOR
SET III=$ORDER(PSNCLEFA(50.68108,II,III))
if III=""
QUIT
Begin DoDot:1
+10 SET PSNPKG=$GET(PSNCLEFA(50.68108,II,.01,"I"))
SET PSNOMIT=$GET(PSNCLEFA(50.68108,II,1,"E"))
+11 SET PSNEXLMT=$GET(PSNCLEFA(50.68108,II,2,"E"))
if PSNPKG'=""
SET PSNCLEF(PSNPKG)=PSNOMIT_"^"_PSNEXLMT
End DoDot:1
+12 ;If package IO is defined only show it, otherwise show all packages
+13 IF $DATA(PSNCLEF("IO"))
SET PSNPKG="IO"
DO CLEFFS
DO CLEFFW(PSNPKG,PSNOMIT,PSNEXLMT)
QUIT QUIT
+14 SET PSNPKG=""
FOR
SET PSNPKG=$ORDER(PSNCLEF(PSNPKG))
if PSNPKG=""
QUIT
Begin DoDot:1
+15 DO CLEFFS
DO CLEFFW(PSNPKG,PSNOMIT,PSNEXLMT)
if QUIT
SET PSNHWQT=1
End DoDot:1
if QUIT
QUIT
+16 QUIT QUIT
+17 ;
CLEFFS ;
+1 SET (PSNOMIT,PSNEXLMT)=""
SET PSNOMIT=$PIECE(PSNCLEF(PSNPKG),"^")
SET PSNEXLMT=$PIECE(PSNCLEF(PSNPKG),"^",2)
+2 QUIT
+3 ;
CLEFFW(PSNPKG,PSNOMIT,PSNEXLMT) ;
+1 NEW PSNPACK2
SET PSNPACK2=""
+2 SET PSNPACK2=$SELECT(PSNPKG="I":"INPATIENT",PSNPKG="O":"OUTPATIENT",PSNPKG="IO":"BOTH INPATIENT AND OUTPATIENT",1:"")
+3 WRITE !?3,PSNPACK2," DURATION LIMIT: "
if PSNOMIT="NO"
WRITE PSNEXLMT
WRITE !?6,"OMIT EXP/DC ORDER CHECK: ",PSNOMIT
+4 if ($Y+5)>IOSL
DO HANG
+5 QUIT
+6 ;
HAZWASTE(VAPRD,QUIT) ;Display Hazardous Waste fields
+1 ;Input: VAPRD - VA PRODUCT (#50.68) IEN
+2 ;returns PSNHWAT = 1 for quit or 0 don't quit.
+3 IF '$GET(QUIT)
SET QUIT=0
+4 if QUIT
QUIT QUIT
+5 NEW HAZARY,HAZHTDX,PSNHWQT
+6 WRITE !
+7 if ($Y+5)>IOSL
DO HANG
if QUIT
GOTO END
+8 DO GETS^DIQ(50.68,VAPRD_",","101;102;103;104;105","EI","HAZARY")
+9 SET HAZHTDX=0
+10 IF $GET(HAZARY(50.68,VAPRD_",",102,"I"))=1
SET HAZHTDX=1
+11 if $GET(HAZARY(50.68,VAPRD_",",101,"E"))'=""
WRITE !,"Hazardous to Handle: ",HAZARY(50.68,VAPRD_",",101,"E")
+12 if ($Y+5)>IOSL
DO HANG
if QUIT
GOTO END
+13 if $GET(HAZARY(50.68,VAPRD_",",102,"E"))'=""
WRITE !,"Hazardous to Dispose: ",HAZARY(50.68,VAPRD_",",102,"E")
+14 if ($Y+5)>IOSL
DO HANG
if QUIT
GOTO END
+15 if $GET(HAZARY(50.68,VAPRD_",",103,"E"))'=""&(HAZHTDX)
WRITE !," Primary EPA Code: ",HAZARY(50.68,VAPRD_",",103,"E")
+16 if ($Y+5)>IOSL
DO HANG
if QUIT
GOTO END
+17 if $GET(HAZARY(50.68,VAPRD_",",104,"E"))'=""&(HAZHTDX)
WRITE !," Waste Sort Code: ",HAZARY(50.68,VAPRD_",",104,"E")
+18 IF QUIT
SET PSNHWQT=1
if QUIT
GOTO END
+19 NEW HAZWCNT,HAZWCNT2,X,DIWL,DIWR,DIWF
+20 KILL ^UTILITY($JOB,"W")
+21 SET HAZWCNT2=1
SET HAZWCNT=0
SET DIWL=1
SET DIWR=50
+22 FOR
SET HAZWCNT=$ORDER(HAZARY(50.68,VAPRD_",",105,HAZWCNT))
if 'HAZWCNT
QUIT
Begin DoDot:1
+23 SET X=""
SET X=HAZARY(50.68,VAPRD_",",105,HAZWCNT)
DO ^DIWP
End DoDot:1
+24 SET HAZWCNT=0
FOR HAZWCNT=0:0
SET HAZWCNT=$ORDER(^UTILITY($JOB,"W",DIWL,HAZWCNT))
if 'HAZWCNT
QUIT
Begin DoDot:1
+25 IF HAZWCNT2=1
WRITE !," DOT Shipping Name: "
+26 IF HAZWCNT2>1
WRITE !," "
+27 WRITE $GET(^UTILITY($JOB,"W",DIWL,HAZWCNT,0))
SET HAZWCNT2=2
End DoDot:1
+28 KILL ^UTILITY($JOB,"W")
+29 ;W:$G(HAZARY(50.68,VAPRD_",",105,"E"))'=""&(HAZHTDX) !," DOT Shipping Name: ",HAZARY(50.68,VAPRD_",",105,"E")
+30 WRITE !
+31 KILL HAZARY,HAZHTDX
END ;
+1 QUIT QUIT
+2 ;
HANG KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press return to continue or '^' to exit"
DO ^DIR
WRITE @IOF
SET $X=0
if Y'=1
SET QUIT=1
+1 QUIT
