Routine: PSNCLEHW

PSNCLEHW ;BIR/LE-CLINICAL EFFECTS & HAZARDOUS WASTE DISPLAY ; 07/02/03 14:01

 ;;4.0;NATIONAL DRUG FILE;**396**; 30 Oct 98;Build 190

 ;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)

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNCLEHW   3347     printed  Feb 18, 2025@23:49:54                                                                                                                                                                                                    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

PSNCLEHW.m