source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPXAPS.m@ 1704

Last change on this file since 1704 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1TIUPXAPS ; SLC/JER - Ask Service Connection Question(s) ;6/11/98@14:30:28
2 ;;1.0;TEXT INTEGRATION UTILITIES;**20,107,126**;Jun 20, 1997
3SCASK(TIUY,DFN,TIU) ; Ask Service Connection stuff
4 N TIUPRMT,TIUSC,TIUDFLT,TIUHLP
5 D SCCOND^PXUTLSCC(DFN,+$G(TIU("EDT")),+$G(TIU("LOC")),+$G(TIU("VISIT")),.TIUSC)
6 ; Don't ask if none of the above
7 I '+$G(TIUSC("SC")),'+$G(TIUSC("AO")),'+$G(TIUSC("IR")),'+$G(TIUSC("EC")),'+$G(TIUSC("MST")),'+$G(TIUSC("HNC")) Q
8 W !!,"Was this encounter related to any of the following:",!
9 I +$G(TIUSC("SC")) D
10 . F D Q:TIUY("SC")]""!$D(DTOUT)
11 . . N DUOUT,DIROUT,DIRUT
12 . . S TIUDFLT=$P(TIUSC("SC"),U,2)
13 . . S TIUDFLT=$S(TIUDFLT=1:"YES",TIUDFLT=0:"NO",1:"")
14 . . S TIUPRMT="Service Connected Condition"
15 . . S TIUY("SC")=$$READ^TIUU("YO",TIUPRMT,TIUDFLT,"^D SC^SDCO23(DFN)")
16 . . I $S(TIUY("SC")="":1,TIUY("SC")="^":1,1:0) S TIUY("SC")="" W !,$C(7),"(Y)ES or (N)o Required." W:$D(DUOUT) " An '^' is not allowed."
17 I +$G(TIUY("SC"))>0 S (TIUY("AO"),TIUY("IR"),TIUY("EC"))=""
18 I +$G(TIUSC("AO")),+$G(TIUY("SC"))'>0 D
19 . F D Q:TIUY("AO")]""!$D(DTOUT)
20 . . N DUOUT,DIROUT,DIRUT
21 . . S TIUDFLT=$P(TIUSC("AO"),U,2)
22 . . S TIUDFLT=$S(TIUDFLT=1:"YES",TIUDFLT=0:"NO",1:"")
23 . . S TIUPRMT=" Agent Orange Exposure"
24 . . S TIUY("AO")=$$READ^TIUU("YO",TIUPRMT,TIUDFLT)
25 . . I +$P($G(TIUDPRM(0)),U,15)=0,(TIUY("AO")="") S TIUY("AO")="^NOT ANSWERED" Q
26 . . I $S(TIUY("AO")="":1,TIUY("AO")="^":1,1:0) S TIUY("AO")="" W !,$C(7),?7,"(Y)ES or (N)o Required." W:$D(DUOUT) " An '^' is not allowed."
27 I +$G(TIUSC("IR")),+$G(TIUY("SC"))'>0 D
28 . F D Q:TIUY("IR")]""!$D(DTOUT)
29 . . N DUOUT,DIROUT,DIRUT
30 . . S TIUDFLT=$P(TIUSC("IR"),U,2)
31 . . S TIUDFLT=$S(TIUDFLT=1:"YES",TIUDFLT=0:"NO",1:"")
32 . . S TIUPRMT="Ionizing Radiation Exposure"
33 . . S TIUY("IR")=$$READ^TIUU("YO",TIUPRMT,TIUDFLT)
34 . . I +$P($G(TIUDPRM(0)),U,15)=0,(TIUY("IR")="") S TIUY("IR")="^NOT ANSWERED" Q
35 . . I $S(TIUY("IR")="":1,TIUY("IR")="^":1,1:0) S TIUY("IR")="" W !,$C(7),"(Y)ES or (N)o Required." W:$D(DUOUT) " An '^' is not allowed."
36 I +$G(TIUSC("EC")),+$G(TIUY("SC"))'>0 D
37 . F D Q:TIUY("EC")]""!$D(DTOUT)
38 . . N DUOUT,DIROUT,DIRUT
39 . . S TIUDFLT=$P(TIUSC("EC"),U,2)
40 . . S TIUDFLT=$S(TIUDFLT=1:"YES",TIUDFLT=0:"NO",1:"")
41 . . S TIUPRMT=" Environmental Contaminants"
42 . . S TIUY("EC")=$$READ^TIUU("YO",TIUPRMT,TIUDFLT)
43 . . I +$P($G(TIUDPRM(0)),U,15)=0,(TIUY("EC")="") S TIUY("EC")="^NOT ANSWERED" Q
44 . . I $S(TIUY("EC")="":1,TIUY("EC")="^":1,1:0) S TIUY("EC")="" W !,$C(7),?2,"(Y)ES or (N)o Required." W:$D(DUOUT) " An '^' is not allowed."
45 I +$G(TIUSC("MST")) D
46 . F D Q:TIUY("MST")]""!$D(DTOUT)
47 . . N DUOUT,DIROUT,DIRUT
48 . . S TIUDFLT=$P(TIUSC("MST"),U,2)
49 . . S TIUDFLT=$S(TIUDFLT=1:"YES",TIUDFLT=0:"NO",1:"")
50 . . S TIUPRMT=" MST"
51 . . S TIUHLP="Enter 'Y' or 'N' if treatment was related to Military Sexual Trauma."
52 . . S TIUY("MST")=$$READ^TIUU("YO",TIUPRMT,TIUDFLT,TIUHLP)
53 . . I $S(TIUY("MST")="":1,TIUY("MST")="^":1,1:0) S TIUY("MST")="" W !,$C(7),?6,"(Y)ES or (N)o Required." W:$D(DUOUT) " An '^' is not allowed."
54 I +$G(TIUSC("HNC")) D
55 . F D Q:TIUY("HNC")]""!$D(DTOUT)
56 . . N DUOUT,DIROUT,DIRUT
57 . . S TIUDFLT=$P(TIUSC("HNC"),U,2)
58 . . S TIUDFLT=$S(TIUDFLT=1:"YES",TIUDFLT=0:"NO",1:"")
59 . . S TIUPRMT=" Head and/or Neck Cancer"
60 . . S TIUHLP="Enter 'Y' or 'N' if treatment was related to Head and/or Neck Cancer."
61 . . S TIUY("HNC")=$$READ^TIUU("YO",TIUPRMT,TIUDFLT,TIUHLP)
62 . . I $S(TIUY("HNC")="":1,TIUY("HNC")="^":1,1:0) S TIUY("HNC")="" W !,$C(7),?6,"(Y)ES or (N)o Required." W:$D(DUOUT) " An '^' is not allowed."
63 Q
Note: See TracBrowser for help on using the repository browser.