82 lines
3.5 KiB
Mathematica
82 lines
3.5 KiB
Mathematica
DGRP6EF ;ALB/TMK,EG - REGISTRATION SCREEN 6 FIELDS FOR EXPOSURE FACTORS; 07/20/2006
|
|
;;5.3;Registration;**689,659,737**;Aug 13, 1993;Build 8
|
|
;
|
|
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
|
|
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)
|
|
S DIR("A",DGCT)=$J("",2)_Z_" A/O Exp.: "_$$YN^DGRP6CL(DG321,2)_$S($P(DG321,U,13)="K":" (DMZ) ",$P(DG321,U,13)="V":" (VIET)",1:$J("",7))_" Reg: "_$$DAT^DGRP6CL(DG321,7,12)_" 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)=$J("",2)_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)
|
|
S DGCT=DGCT+1,DIR("A",DGCT)=$J("",2)_Z_" Env Contam: "_$$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)=$J("",2)_$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 ")
|
|
S DIR(0)=$S('$G(DGRPV):"SA^1:A/O Exp;2:ION Rad;3:Env Contam;"_$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)=""
|
|
. S Z="Env Contam.",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)
|
|
Q
|
|
; 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)
|
|
;;
|