source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTSPQ.m@ 1489

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1DGPTSPQ ;ALB/MTC - PTF Utility Con; 3/5/93 ; 11/26/03 9:56am
2 ;;5.3;Registration;**195,397,565**;Aug 13, 1993
3 ;
4CHQUES ;-- This function will determine if the patient has any of the
5 ; following indicated : AO, IR, EC, MST, NTR
6 ; If so the array DGEXQ will contain:
7 ; DGEXQ(1)="" - AO
8 ; DGEXQ(2)="" - IR
9 ; DGEXQ(3)="" - EC
10 ; DGEXQ(4)="" - MST ;added 6/17/98 for MST enhancement
11 ; DGEXQ(5)="" - NTR ;treatment for Head/Neck CA
12 ; ;ONLY if (#28.11) Nose Throat Radium entered
13 ; DGEXQ(6)="" - CV ;treatment for possible combat related
14 ; ;condition
15 ; Otherwise they will be undefined.
16 ; This routine is called from the PTF input templates.
17 ; The following variables are defined:
18 ; DGHOLD : Movemnent record before any changes been made.
19 ; DGPTF : PTF Record Number.
20 ; DGMOV : PTF Movement Number (optional)
21 N DGHOLD,SDCLY
22 S DGHOLD=^DGPT(DA(1),"M",DA,0),SDCLY=""
23 ;-- call to determine if questions should be asked. OPC uses same
24 ; criteria.
25 D CL^SDCO21(DFN,$P(DGHOLD,U,10),"",.SDCLY)
26 ;
27 ;-- if sc > 50% and treated for sc don't ask AO/IR
28 ;-- ADD KILL OF SDCLY(6) TO SKIP COMBAT VETERAN QUESTION
29 I $P($G(^DGPT(DGPTF,"M",+$G(DGMOV),0)),U,18)=1 K SDCLY(1),SDCLY(2)
30 ;
31 G:'$D(SDCLY) CHQ
32 ; AO
33 I $D(SDCLY(1)) S DGEXQ(1)=""
34 ; IR
35 I $D(SDCLY(2)) S DGEXQ(2)=""
36 ; EC
37 I $D(SDCLY(4)) S DGEXQ(3)=""
38 ; MST
39 I $D(SDCLY(5)) S DGEXQ(4)="" ;added 6/17/98 for MST enhancement
40 ; NTR
41 I $D(SDCLY(6)) S DGEXQ(5)=""
42 ; CV
43 I $D(SDCLY(7)) S DGEXQ(6)=""
44CHQ Q
45 ;
46501 ;-- This is the input transform logic for the following questions:
47 ; AO, IR, EC, MST, NTR
48 ; Process: Make sure that the conditions are indicated before
49 ; allowing data to be entered. If the indicators are
50 ; not present and the question was answered, DGER
51 ; will be set to 1.
52 ; INPUT : DGFLAG - Field to check
53 ; DGER - DGER error code
54 N DGEXQ
55 S DGER=0
56 D CHQUES
57 I '$D(DGEXQ(+DGFLAG)) S DGER=1
58 Q
59 ;
60701 ;-- This is the input transform logic for the following questions
61 ; for the <701> PTF record: AO, IR, EC, MST, NTR
62 ; Process: Check if the desired indicator was answered on a <501>.
63 ; changed 6/17/98 for MST enhancement
64 ; INPUT DGFLAG - 1=AO, 2=IR, 3=EC, 4=MST, 5=NTR, 6=CV
65 N I
66 S DGER=1
67 ;-- loop thru <501>'s for indicator specified by DGFLAG
68 S I=0 F S I=$O(^DGPT(DA,"M",I)) Q:'I I $P($G(^DGPT(DA,"M",I,0)),U,DGFLAG+25)'="" S DGER=0 Q
69 Q
70 ;
71UP701 ;-- This function will loop thru the <501> and determine if any
72 ; of the SC, AO, IR, EC, MST, NTR, and CV questions have been
73 ; answered. If so, the cooresponding <701> will be updated.
74 ; An answer of "yes" will take presidence.
75 ;
76 ; INPUT : DGPTF
77 ; changed 6/17/98 for MST emhancement
78 N I,DGSC,DGAO,DGIR,DGEC,DGMOV,DGMST,DGNTR,DGCV
79 S (DGSC,DGAO,DGIR,DGEC,DGMST,DGNTR,DGCV)="@"
80 ;-- loop thru <501>s
81 S I=0 F S I=$O(^DGPT(DGPTF,"M",I)) Q:'I S DGMOV=$G(^(I,0)) I DGMOV'="" D
82 .;-- sc
83 .I $P(DGMOV,U,18)'="",DGSC'=1 S DGSC=$P(DGMOV,U,18)
84 .;-- ao
85 .I $P(DGMOV,U,26)'="",DGAO'="Y" S DGAO=$P(DGMOV,U,26)
86 .;-- ir
87 .I $P(DGMOV,U,27)'="",DGIR'="Y" S DGIR=$P(DGMOV,U,27)
88 .;-- ec
89 .I $P(DGMOV,U,28)'="",DGEC'="Y" S DGEC=$P(DGMOV,U,28)
90 .;-- mst ;added 6/17/98 for MST enhancement
91 .I $P(DGMOV,U,29)'="",DGMST'="Y" S DGMST=$P(DGMOV,U,29)
92 .;-- ntr
93 .I $P(DGMOV,U,30)'="",DGNTR'="Y" S DGNTR=$P(DGMOV,U,30)
94 .;-- cv
95 .I $P(DGMOV,U,31)'="",DGCV'="Y" S DGCV=$P(DGMOV,U,31)
96 ;-- update <701> fields
97 ; changed 6/17/98 for MST enhancement
98 S DR="79.25////^S X=DGSC;79.26////^S X=DGAO;79.27////^S X=DGIR;79.28////^S X=DGEC;79.29////^S X=DGMST;79.3////^S X=DGNTR;79.31////^S X=DGCV"
99 S DA=DGPTF,DIE="^DGPT("
100 D ^DIE K DIE,DA,DR
101UPQ Q
102 ;
Note: See TracBrowser for help on using the repository browser.