Routine: DGRP6EF

DGRP6EF ;ALB/TMK,EG,BAJ - REGISTRATION SCREEN 6 FIELDS FOR EXPOSURE FACTORS; 07/20/2006

 ;;5.3;PIMS;**689,659,737,1015,1016**;JUN 30, 2012;Build 20

EN(DFN,QUIT) ; Display Environmental exposure factors/allow to edit

 N I,IND,DG321,DG322,DGCT,DIR,Z,X,Y,DIE,DR,DA,DGNONT

 ; Returns QUIT=1 if ^ entered

EN1 D CLEAR^VALM1

 N DTOUT,DUOUT,TYPE,SEL,L,S,L1,L2,L3

 S DG321=$G(^DPT(DFN,.321)),DG322=$G(^DPT(DFN,.322))

 S DIR(0)="SA^",DGCT=0

 S DGCT=DGCT+1,DIR("A",DGCT)=$$SSNNM^DGRPU(DFN)

 S DGCT=DGCT+1,DIR("A",DGCT)="",$P(DIR("A",DGCT),"=",81)=""

 S DGCT=DGCT+1,DIR("A",DGCT)=$J("",23)_"**** ENVIRONMENTAL FACTORS ****",DGCT=DGCT+1,DIR("A",DGCT)=" "

 S IND=$S('$G(DGRPV):"[]",1:"<>")

 S DGCT=DGCT+1

 S Z=$E(IND)_"1"_$E(IND,2)

 ; "OTHER" choice added DG*5.3*688

 ; variables S,L1,L2, & L3 used for dynamic spacing

 S SEL=$P(DG321,U,13),S=$C(32),($P(L1,S,6),$P(L2,S,$S(SEL="O":3,1:2)),$P(L3,S,3))=""

 S TYPE=$S(SEL="K":" (DMZ) ",SEL="V":" (VIET)",SEL="O":" (OTH)",1:$J("",7))

 S DIR("A",DGCT)=Z_L1_"A/O Exp.: "_$$YN^DGRP6CL(DG321,2)_TYPE_L2_"Reg: "_$$DAT^DGRP6CL(DG321,7,12)_L3_"Exam: "_$$DAT^DGRP6CL(DG321,9,12)_"A/O#: "_$P(DG321,U,10)

 S Z=$E(IND)_"2"_$E(IND,2)

 S DGCT=DGCT+1,DIR("A",DGCT)=Z_"     ION Rad.: "_$$YN^DGRP6CL(DG321,3)_$J("",8)_"Reg: "_$$DAT^DGRP6CL(DG321,11,12)_"Method: "

 S:$P(DG321,U,12)>7 $P(DG321,U,12)="" S DIR("A",DGCT)=DIR("A",DGCT)_$P($T(SELTBL+$P(DG321,U,12)),";;",2)

 S Z=$E(IND)_"3"_$E(IND,2)

 ;Env Contam name changed to SW Asia Conditions, DG*5.3*688

 S DGCT=DGCT+1,DIR("A",DGCT)=Z_" SW Asia Cond: "_$$YN^DGRP6CL(DG322,13)_$J("",8)_"Reg: "_$$DAT^DGRP6CL(DG322,14,12)_"  Exam: "_$$DAT^DGRP6CL(DG322,15,11)

 S DGNONT=0 I $$GETSTAT^DGNTAPI1(DFN)>2,'$D(^XUSEC("DGNT VERIFY",DUZ)) S DGNONT=1

 I $G(DGRPV) S DGNONT=1

 S DGCT=DGCT+1,DIR("A",DGCT)=$S(DGNONT:"<",1:"[")_"4"_$S(DGNONT:">",1:"]")_"   N/T Radium: " N DGNT S DGRPX=$$GETCUR^DGNTAPI(DFN,"DGNT") S DIR("A",DGCT)=DIR("A",DGCT)_$G(DGNT("INTRP"))

 S DGCT=DGCT+1,DIR("A",DGCT)=" "

 S DIR("A")=$S('$G(DGRPV):"SELECT AN ENVIRONMENTAL FACTOR (1-"_(4-DGNONT)_") OR (Q)UIT: ",1:"PRESS RETURN TO CONTINUE ")

 ;Env Contam name changed to SW Asia Conditions, DG*5.3*688

 S DIR(0)=$S('$G(DGRPV):"SA^1:A/O Exp;2:ION Rad;3:SW Asia Cond;"_$S(DGNONT:"",1:"4:N/T Radium;")_"Q:QUIT",1:"EA")

 I '$G(DGRPV) S DIR("B")="QUIT"

 D ^DIR K DIR

 I $G(DGRPV)!$D(DUOUT)!$D(DTOUT)!(Y="Q") S:Y'="Q" QUIT=1 G QUIT

 S Z="603"_$E("0",2-$L(+Y))_+Y

 S DIE=2,DA=DFN,DR=$P($T(@Z),";;",2) D:DR'="" ^DIE

 K DIE,DA,DR

 G EN1

QUIT Q

EF(DFN,LIN) ;

 N DG321,DG322,LENGTH,Z,SEQ

 K LIN S (LENGTH,LIN)=0

 S DG321=$G(^DPT(DFN,.321)),DG322=$G(^(.322))

 I $P(DG321,U,2)="Y" D

 . S Z="A/O Exp.",SEQ=1

 . ;S:'$P(DG321,U,7)!'$P(DG321,U,9)!($P(DG321,U,10)="") Z=Z_"(Incomplete)"

 . S:'$P(DG321,U,7)!('$P(DG321,U,9))="" Z=Z_"(Incomplete)"

 . D SETLNEX^DGRP6(Z,SEQ,.LIN,.LENGTH)

 I $P(DG321,U,3)="Y" D

 . S Z="Ion Rad.",SEQ=2

 . S:'$P(DG321,U,11)!($P(DG321,U,12)="") Z=Z_"(Incomplete)"

 . D SETLNEX^DGRP6(Z,SEQ,.LIN,.LENGTH)

 I $P(DG322,U,13)="Y" D

 . I 'LIN S LIN=LIN+1,LIN(LIN)=""

 . ;Env Contam name changed to SW Asia Conditions, DG*5.3*688

 . S Z="SW Asia Cond.",SEQ=3

 . S:'$P(DG322,U,14)!'$P(DG322,U,15) Z=Z_"(Incomplete)"

 . D SETLNEX^DGRP6(Z,SEQ,.LIN,.LENGTH)

 ; N/T Radium Exposure

 N DGNT,DGRPX S DGRPX=$$GETCUR^DGNTAPI(DFN,"DGNT")

 I "NO"'[$G(DGNT("INTRP")) D

 . I 'LIN S LIN=LIN+1,LIN(LIN)=""

 . S SEQ=4 D SETLNEX^DGRP6("N/T Radium ("_$P(DGNT("INTRP"),"YES,",2)_")",SEQ,.LIN,.LENGTH)

  ; The following tag is a table of values.  Do not change location of values including null at SELTBL+0

SELTBL ;;

 ;;NO VALUE

 ;;HIROSHIMA/NAGASAKI

 ;;ATMOSPHERIC NUCLEAR TEST

 ;;H/N AND ATMOSPHERIC TEST

 ;;UNDERGROUND NUCLEAR TEST

 ;;EXP. AT NUCLEAR FACILITY

 ;;OTHER

60301 ;;.32102//NO;S:X'="Y" Y="@65";.3213;.32107;.32109;.3211;@65;

60302 ;;.32103//NO;S:X'="Y" Y="@66";.3212;.32111;@66;

60303 ;;.322013//NO;S:X'="Y" Y="@612";.322014;Q;.322015;@612;

60304 ;;D REG^DGNTQ(DFN)

;;

DGRP6EF   ;ALB/TMK,EG,BAJ - REGISTRATION SCREEN 6 FIELDS FOR EXPOSURE FACTORS; 07/20/2006

 +1       ;;5.3;PIMS;**689,659,737,1015,1016**;JUN 30, 2012;Build 20

 +2       ;

EN(DFN,QUIT) ; Display Environmental exposure factors/allow to edit

 +1        NEW I,IND,DG321,DG322,DGCT,DIR,Z,X,Y,DIE,DR,DA,DGNONT

 +2       ; Returns QUIT=1 if ^ entered

 +3       ;

EN1        DO CLEAR^VALM1

 +1        NEW DTOUT,DUOUT,TYPE,SEL,L,S,L1,L2,L3

 +2        SET DG321=$GET(^DPT(DFN,.321))

           SET DG322=$GET(^DPT(DFN,.322))

 +3       ;

 +4        SET DIR(0)="SA^"

           SET DGCT=0

 +5        SET DGCT=DGCT+1

           SET DIR("A",DGCT)=$$SSNNM^DGRPU(DFN)

 +6        SET DGCT=DGCT+1

           SET DIR("A",DGCT)=""

           SET $PIECE(DIR("A",DGCT),"=",81)=""

 +7        SET DGCT=DGCT+1

           SET DIR("A",DGCT)=$JUSTIFY("",23)_"**** ENVIRONMENTAL FACTORS ****"

           SET DGCT=DGCT+1

           SET DIR("A",DGCT)=" "

 +8        SET IND=$SELECT('$GET(DGRPV):"[]",1:"<>")

 +9        SET DGCT=DGCT+1

 +10       SET Z=$EXTRACT(IND)_"1"_$EXTRACT(IND,2)

 +11      ; "OTHER" choice added DG*5.3*688

 +12      ; variables S,L1,L2, & L3 used for dynamic spacing

 +13       SET SEL=$PIECE(DG321,U,13)

           SET S=$CHAR(32)

           SET ($PIECE(L1,S,6),$PIECE(L2,S,$SELECT(SEL="O":3,1:2)),$PIECE(L3,S,3))=""

 +14       SET TYPE=$SELECT(SEL="K":" (DMZ) ",SEL="V":" (VIET)",SEL="O":" (OTH)",1:$JUSTIFY("",7))

 +15       SET DIR("A",DGCT)=Z_L1_"A/O Exp.: "_$$YN^DGRP6CL(DG321,2)_TYPE_L2_"Reg: "_$$DAT^DGRP6CL(DG321,7,12)_L3_"Exam: "_$$DAT^DGRP6CL(DG321,9,12)_"A/O#: "_$PIECE(DG321,U,10)

 +16       SET Z=$EXTRACT(IND)_"2"_$EXTRACT(IND,2)

 +17       SET DGCT=DGCT+1

           SET DIR("A",DGCT)=Z_"     ION Rad.: "_$$YN^DGRP6CL(DG321,3)_$JUSTIFY("",8)_"Reg: "_$$DAT^DGRP6CL(DG321,11,12)_"Method: "

 +18       IF $PIECE(DG321,U,12)>7

               SET $PIECE(DG321,U,12)=""

           SET DIR("A",DGCT)=DIR("A",DGCT)_$PIECE($TEXT(SELTBL+$PIECE(DG321,U,12)),";;",2)

 +19       SET Z=$EXTRACT(IND)_"3"_$EXTRACT(IND,2)

 +20      ;Env Contam name changed to SW Asia Conditions, DG*5.3*688

 +21       SET DGCT=DGCT+1

           SET DIR("A",DGCT)=Z_" SW Asia Cond: "_$$YN^DGRP6CL(DG322,13)_$JUSTIFY("",8)_"Reg: "_$$DAT^DGRP6CL(DG322,14,12)_"  Exam: "_$$DAT^DGRP6CL(DG322,15,11)

 +22       SET DGNONT=0

           IF $$GETSTAT^DGNTAPI1(DFN)>2

               IF '$DATA(^XUSEC("DGNT VERIFY",DUZ))

                   SET DGNONT=1

 +23       IF $GET(DGRPV)

               SET DGNONT=1

 +24       SET DGCT=DGCT+1

           SET DIR("A",DGCT)=$SELECT(DGNONT:"<",1:"[")_"4"_$SELECT(DGNONT:">",1:"]")_"   N/T Radium: "

           NEW DGNT

           SET DGRPX=$$GETCUR^DGNTAPI(DFN,"DGNT")

           SET DIR("A",DGCT)=DIR("A",DGCT)_$GET(DGNT("INTRP"))

 +25      ;

 +26       SET DGCT=DGCT+1

           SET DIR("A",DGCT)=" "

 +27       SET DIR("A")=$SELECT('$GET(DGRPV):"SELECT AN ENVIRONMENTAL FACTOR (1-"_(4-DGNONT)_") OR (Q)UIT: ",1:"PRESS RETURN TO CONTINUE ")

 +28      ;Env Contam name changed to SW Asia Conditions, DG*5.3*688

 +29       SET DIR(0)=$SELECT('$GET(DGRPV):"SA^1:A/O Exp;2:ION Rad;3:SW Asia Cond;"_$SELECT(DGNONT:"",1:"4:N/T Radium;")_"Q:QUIT",1:"EA")

 +30       IF '$GET(DGRPV)

               SET DIR("B")="QUIT"

 +31       DO ^DIR

           KILL DIR

 +32       IF $GET(DGRPV)!$DATA(DUOUT)!$DATA(DTOUT)!(Y="Q")

               IF Y'="Q"

                   SET QUIT=1

               GOTO QUIT

 +33       SET Z="603"_$EXTRACT("0",2-$LENGTH(+Y))_+Y

 +34       SET DIE=2

           SET DA=DFN

           SET DR=$PIECE($TEXT(@Z),";;",2)

           IF DR'=""

               DO ^DIE

 +35       KILL DIE,DA,DR

 +36       GOTO EN1

 +37      ;

QUIT       QUIT

 +1       ;

EF(DFN,LIN) ;

 +1        NEW DG321,DG322,LENGTH,Z,SEQ

 +2        KILL LIN

           SET (LENGTH,LIN)=0

 +3        SET DG321=$GET(^DPT(DFN,.321))

           SET DG322=$GET(^(.322))

 +4        IF $PIECE(DG321,U,2)="Y"

               Begin DoDot:1

 +5                SET Z="A/O Exp."

                   SET SEQ=1

 +6       ;S:'$P(DG321,U,7)!'$P(DG321,U,9)!($P(DG321,U,10)="") Z=Z_"(Incomplete)"

 +7                IF '$PIECE(DG321,U,7)!('$PIECE(DG321,U,9))=""

                       SET Z=Z_"(Incomplete)"

 +8                DO SETLNEX^DGRP6(Z,SEQ,.LIN,.LENGTH)

               End DoDot:1

 +9       ;

 +10       IF $PIECE(DG321,U,3)="Y"

               Begin DoDot:1

 +11               SET Z="Ion Rad."

                   SET SEQ=2

 +12               IF '$PIECE(DG321,U,11)!($PIECE(DG321,U,12)="")

                       SET Z=Z_"(Incomplete)"

 +13               DO SETLNEX^DGRP6(Z,SEQ,.LIN,.LENGTH)

               End DoDot:1

 +14      ;

 +15       IF $PIECE(DG322,U,13)="Y"

               Begin DoDot:1

 +16               IF 'LIN

                       SET LIN=LIN+1

                       SET LIN(LIN)=""

 +17      ;Env Contam name changed to SW Asia Conditions, DG*5.3*688

 +18               SET Z="SW Asia Cond."

                   SET SEQ=3

 +19               IF '$PIECE(DG322,U,14)!'$PIECE(DG322,U,15)

                       SET Z=Z_"(Incomplete)"

 +20               DO SETLNEX^DGRP6(Z,SEQ,.LIN,.LENGTH)

               End DoDot:1

 +21      ; N/T Radium Exposure

 +22       NEW DGNT,DGRPX

           SET DGRPX=$$GETCUR^DGNTAPI(DFN,"DGNT")

 +23       IF "NO"'[$GET(DGNT("INTRP"))

               Begin DoDot:1

 +24               IF 'LIN

                       SET LIN=LIN+1

                       SET LIN(LIN)=""

 +25               SET SEQ=4

                   DO SETLNEX^DGRP6("N/T Radium ("_$PIECE(DGNT("INTRP"),"YES,",2)_")",SEQ,.LIN,.LENGTH)

               End DoDot:1

 +26       QUIT

 +27      ; The following tag is a table of values.  Do not change location of values including null at SELTBL+0

SELTBL    ;;

 +1       ;;NO VALUE

 +2       ;;HIROSHIMA/NAGASAKI

 +3       ;;ATMOSPHERIC NUCLEAR TEST

 +4       ;;H/N AND ATMOSPHERIC TEST

 +5       ;;UNDERGROUND NUCLEAR TEST

 +6       ;;EXP. AT NUCLEAR FACILITY

 +7       ;;OTHER

60301     ;;.32102//NO;S:X'="Y" Y="@65";.3213;.32107;.32109;.3211;@65;

60302     ;;.32103//NO;S:X'="Y" Y="@66";.3212;.32111;@66;

60303     ;;.322013//NO;S:X'="Y" Y="@612";.322014;Q;.322015;@612;

60304     ;;D REG^DGNTQ(DFN)

 +1       ;;

DGRP6EF.m