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

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1DGMTDD ;ALB/RMO,CAW,CJM,LBD,PHH - Annual Means Test file (#408.31) Data Dictionary Calls ; 2/10/2005 9:12am
2 ;;5.3;Registration;**33,182,411,456,618**;Aug 13, 1993
3 ;
4CUR ;Cross-reference on the Status field (#.03)
5 ;to update the Current Means Test Status field (#.14)
6 ;in the Patient file (#2)
7 N DFN,DGCS,DGDT,DGIX,DGMTI,DGMTS,DGNAM
8 S DFN=$P($G(^DGMT(408.31,DA,0)),U,2),DGCS=$P($G(^DPT(DFN,0)),U,14),(DGDT,DGMTS)=""
9 ;
10 S DGNAM=$P($G(^DPT(DFN,0)),"^",1)
11 Q:DGNAM=""
12 Q:'$D(^DPT("B",DGNAM))
13 ;
14 S DGMTI=+$$MTIENLT^DGMTU3(1,DFN,"")
15 I $D(^DGMT(408.31,DGMTI,0)) S DGMTS=$P(^(0),U,3) G CURQ:DGCS=DGMTS
16 I DGCS]"" D
17 .N DA,X
18 .S DA=DFN,X=DGCS,DGIX=0
19 .F S DGIX=$O(^DD(2,.14,1,DGIX)) Q:'DGIX X ^(DGIX,2) S X=DGCS
20 S $P(^DPT(DFN,0),U,14)=DGMTS I DGMTS]"" D
21 .N DA,X
22 .S DA=DFN,X=DGMTS,DGIX=0
23 .F S DGIX=$O(^DD(2,.14,1,DGIX)) Q:'DGIX X ^(DGIX,1) S X=DGMTS
24CURQ Q
25 ;
26COM ;Input Transform check of the Completion date/time field (#.07)
27 N DGDT,DGMT0,XMB,XMDUZ
28 S DGMT0=$G(^DGMT(408.31,DA,0))
29 I X<+DGMT0 W !?5,"The completion date/time cannot be before the date of test." K X
30 I $D(X) S DGDT=+$O(^DGMT(408.31,"AD",$P(DGMT0,U,19),$P(DGMT0,U,2),+DGMT0)) I DGDT,X'<DGDT W !?5,"The completion date/time cannot be after the next date of test." K X
31 ; DG*5.3*411 - MT Completion Bulletin
32 ;
33 I $D(X) D
34 . N EASDT S EASDT=X
35 . Q:'$$GET1^DIQ(713,1,7,"I")
36 . Q:$P(DGMT0,U,19)'=1
37 . S XMB="EAS MTCOMPLETION"
38 . S XMB(1)=$$GET1^DIQ(2,$P(DGMT0,U,2),.01)
39 . S XMB(2)=$E($$GET1^DIQ(2,$P(DGMT0,U,2),.09),6,10)
40 . S XMB(3)=$$FMTE^XLFDT(EASDT)
41 . S XMB(4)=$$GET1^DIQ(200,DUZ,.01)
42 . S XMDUZ="EAS MT Completion"
43 . D ^XMB
44COMQ Q
45 ;
46SCR(DGMTS,DGMTI,DGMTYPT,DGMTACT) ;Screen for the Status field (#.03)
47 ; Input -- DGMTS Means Test Status IEN
48 ; DGMTI Annual Means Test IEN
49 ; DGMTYPT Type of Test 1=MT 2=COPAY
50 ; DGMTACT Means Test Action (Opt)
51 ; Output -- 1=SELECTABLE and 0=NOT SELECTABLE
52 N DA,DGMT0,DGMTDT,Y
53 S DGMT0=$G(^DGMT(408.31,DGMTI,0)),DGMTDT=+DGMT0
54 I DGMTYPT=1,$$ACT(DGMTS,DGMTDT),$$MTS(DGMTS,DGMTDT,DGMT0,$G(DGMTACT),DGMTYPT) S Y=1
55 I DGMTYPT=2,$$ACT(DGMTS,DGMTDT),$P(^DG(408.32,DGMTS,0),U,19)=2,$$MTS(DGMTS,DGMTDT,DGMT0,$G(DGMTACT),DGMTYPT) S Y=1
56 Q +$G(Y)
57 ;
58ACT(DGMTS,DGMTDT) ;Determine if means test status is active
59 ; Input -- DGMTS Means Test Status IEN
60 ; DGMTDT Date of Test
61 ; Output -- 1=ACTIVE and 0=INACTIVE
62 N Y
63 S:'$P(DGMTDT,".",2) DGMTDT=DGMTDT_.2359
64 I $D(^DG(408.32,DGMTS,"E",+$O(^(+$O(^DG(408.32,DGMTS,"E","AID",-DGMTDT)),0)),0)),$P($G(^(0)),U,2) S Y=1
65 Q +$G(Y)
66 ;
67MTS(DGMTS,DGMTDT,DGMT0,DGMTACT,DGMTYPT) ;Determine if means test status is selectable
68 ; Input -- DGMTS Means Test Status IEN
69 ; DGMTDT Date of Test
70 ; DGMT0 Annual Means Test 0th node
71 ; DGMTACT Means Test Action (Opt)
72 ; DGMTYPT Type of Test 1=MT 2=COPAY
73 ; Output -- 1=SELECTABLE and 0=NOT SELECTABLE
74 N DGDET,DGINT,DGLY,DGMTPAR,DGNWT,DGOMTS,DGTHA,DGTHB,DGTHPF,DGTSRC
75 N DGMTNWC,DGNW,DGTHG
76 S Y=0
77 I DGMTYPT=1 D
78 .S DGOMTS=$P(DGMT0,U,3),DGINT=$P(DGMT0,U,4),DGNWT=$P(DGMT0,U,5),DGDET=$P(DGMT0,U,15),DGLY=$E(DGMTDT,1,3)-1_"0000"
79 .S:$$ACT(4,DGMTDT) DGTHA=$P(DGMT0,U,12) S:$$ACT(5,DGMTDT) DGTHB=$P(DGMT0,U,13) S:$$ACT(16,DGMTDT) DGTHG=$P(DGMT0,U,27)
80 .S DGMTPAR=$G(^DG(43,1,"MT",$S($P(DGMT0,U,16):DGLY,1:DGLY+10000),0))
81 .S DGMTNWC=+$G(^DG(43,1,"GMT"))
82 .S DGNW=DGNWT-DGDET+$S(DGMTNWC:0,1:DGINT)
83 .S DGTHPF=$S(DGNW'<$P(DGMTPAR,U,8):1,1:0)
84 .S DGTSRC=$P($G(^DG(408.34,+$P(DGMT0,U,23),0)),U)
85 .I DGMTS=2,$G(DGMTACT)="CAT" D
86 ..S:DGTHPF Y=1
87 ..S:((DGTSRC="VAMC")&(DGOMTS=4)) Y=0
88 .I DGMTS=4 S Y=1
89 .I DGMTS=5 D
90 ..S:DGTHPF!(DGINT>$G(DGTHA)) Y=1
91 ..S:((DGTSRC="VAMC")&(DGOMTS=4)) Y=0
92 .I DGMTS=6 D
93 ..S:DGTHPF!(DGINT>$G(DGTHA)&(DGINT>$G(DGTHG))) Y=1
94 ..S:(DGOMTS=2)&($G(DGTHG)>$G(DGTHA)) Y=0
95 ..S:((DGTSRC="VAMC")&(DGOMTS=4)) Y=0
96 .I DGMTS=16 D
97 ..S:$G(DGTHG)>$G(DGTHA)&(DGTHPF!(DGINT>$G(DGTHA))) Y=1
98 ..S:((DGTSRC="VAMC")&(DGOMTS=4)) Y=0
99 I DGMTYPT=2 D
100 .I DGMTS=7 S Y=1
101 .I DGMTS=8 S Y=1
102 .I DGMTS=9 S Y=1
103 .I DGMTS=10 S Y=0
104 .I DGMTS=11 S Y=0
105 Q +$G(Y)
106 ;
107STOPAUTO(DA) ;
108 ;This is the kill logic for an xref on the Test Determined Status field.
109 ;If the status changes, and there is a linked test via the Linked
110 ;Rx Copay/Means Test field, the Test Determined Status of the linked
111 ;test should be deleted.
112 ;
113 ;Input - DA is the ien of a test in the Annual Means Test file
114 ;Output - none
115 ;
116 N LINKEDMT
117 Q:'$G(DA)
118 S LINKEDMT=$P($G(^DGMT(408.31,DA,2)),"^",6)
119 I LINKEDMT D
120 .S $P(^DGMT(408.31,LINKEDMT,2),"^",2)=$$NOW^XLFDT
121 .S $P(^DGMT(408.31,LINKEDMT,2),"^",3)=""
122 Q
Note: See TracBrowser for help on using the repository browser.