Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSNCLEHW

PSNCLEHW.m

Go to the documentation of this file.
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