source: WorldVistAEHR/trunk/r/CPT_HCPCS_CODES-ICPT-DGYA/ICPTMIDX.m@ 619

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1ICPTMIDX ;DLS/DEK - MUMPS Cross Reference Routine for History ; 04/28/2003
2 ;;6.0;CPT/HCPCS;**14**;May 19, 1997;Build 1
3 ;
4 ; ICPTMOD CPT/HCPC Code Modifier from Global
5 ; ICPTMODX CPT/HCPC Code Modifier passed in (X)
6 ; ICPTEFF Effective Date
7 ; ICPTSTA Status
8 ; ICPTNOD Global Node (to reduce Global hits)
9 ; DA ien file 81.3 or 81.33
10 ; ICPTIEN,DA(1) ien of file 81.3
11 ; ICPTHIS ien of file 81.33
12 ; X Data passed in to be indexed
13 ;
14 ; Set and Kill Activation History
15 ;
16 ; File 81.3, field .01
17SAHC ; Set new value when CPT Code Modifier is Edited
18 ; ^DD(81.3,.01,1,D0,1) = D SAHC^ICPTMIDX
19 N ICPTNOD,ICPTSTA,ICPTEFF,ICPTMOD,ICPTMODX,ICPTHIS,ICPTIEN
20 S ICPTMODX=$G(X) Q:'$L(ICPTMODX) S ICPTIEN=+($G(DA)) Q:+ICPTIEN'>0
21 S ICPTHIS=0 F S ICPTHIS=$O(^DIC(81.3,+ICPTIEN,60,ICPTHIS)) Q:+ICPTHIS=0 D
22 . N DA,X S DA=+ICPTHIS,DA(1)=+ICPTIEN D HDC
23 . S ICPTMOD=ICPTMODX Q:'$L($G(ICPTMOD))
24 . Q:'$L($G(ICPTEFF)) Q:'$L($G(ICPTSTA)) D SHIS
25 Q
26KAHC ; Kill old value when CPT Code is Edited
27 ; ^DD(81.3,.01,1,D0,2) = D KAHC^ICPTMIDX
28 N ICPTNOD,ICPTSTA,ICPTEFF,ICPTMOD,ICPTMODX,ICPTHIS,ICPTIEN
29 S ICPTMODX=$G(X) Q:'$L(ICPTMODX) S ICPTIEN=+($G(DA)) Q:+ICPTIEN'>0
30 S ICPTHIS=0 F S ICPTHIS=$O(^DIC(81.3,+ICPTIEN,60,ICPTHIS)) Q:+ICPTHIS=0 D
31 . N DA,X S DA=+ICPTHIS,DA(1)=+ICPTIEN D HDC
32 . S ICPTMOD=ICPTMODX Q:'$L($G(ICPTMOD))
33 . Q:'$L($G(ICPTEFF)) Q:'$L($G(ICPTSTA)) D KHIS
34 Q
35 ;
36 ; File 81.33, field .01
37SAHD ; Set new value when Effective Date is Edited
38 ; ^DD(81.33,.01,1,D0,1) = D SAHD^ICPTMIDX
39 N ICPTNOD,ICPTSTA,ICPTEFF,ICPTMOD
40 D HDC Q:'$L($G(ICPTMOD)) Q:'$L($G(ICPTSTA)) S ICPTEFF=+($G(X)) Q:+ICPTEFF=0 D SHIS
41 Q
42KAHD ; Kill old value when Effective Date is Edited
43 ; ^DD(81.33,.01,1,D0,2) = D KAHD^ICPTMIDX
44 N ICPTNOD,ICPTSTA,ICPTEFF,ICPTMOD
45 D HDC Q:'$L($G(ICPTMOD)) Q:'$L($G(ICPTSTA))
46 S ICPTEFF=+($G(X)) Q:+ICPTEFF=0 D KHIS
47 Q
48 ;
49 ; File 81.33, field .02
50SAHS ; Set new value when Status is Edited
51 ; ^DD(81.33,.02,1,D0,1) = D SAHS^ICPTMIDX
52 N ICPTNOD,ICPTSTA,ICPTEFF,ICPTMOD
53 D HDC Q:'$L($G(ICPTMOD)) Q:+ICPTEFF=0
54 S ICPTSTA=$G(X) Q:'$L(ICPTSTA) D SHIS
55 Q
56KAHS ; Kill old value when Status is Edited
57 ; ^DD(81.33,.02,1,D0,2) = D KAHS^ICPTMIDX
58 N ICPTNOD,ICPTSTA,ICPTEFF,ICPTMOD
59 D HDC Q:'$L($G(ICPTMOD)) Q:+ICPTEFF=0
60 S ICPTSTA=$G(X) Q:'$L(ICPTSTA) D KHIS
61 Q
62 ;
63HDC ; Set Common Variables (Code, Status and Effective Date)
64 S (ICPTMOD,ICPTSTA,ICPTEFF)=""
65 Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 Q:'$D(^DIC(81.3,+($G(DA(1))),60,+($G(DA)),0))
66 S ICPTMOD=$P($G(^DIC(81.3,+($G(DA(1))),0)),"^",1),ICPTNOD=$G(^DIC(81.3,+($G(DA(1))),60,+($G(DA)),0))
67 S ICPTSTA=$P(ICPTNOD,"^",2),ICPTEFF=$P(ICPTNOD,"^",1)
68 Q
69 ;
70SHIS ; Set Index ^DIC(81.3,"ACT",<code>,<status>,<date>,<ien>,<history>)
71 Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 Q:'$D(^DIC(81.3,+($G(DA(1))),60,+($G(DA)),0))
72 S ^DIC(81.3,"ACT",(ICPTMOD_" "),ICPTSTA,ICPTEFF,DA(1),DA)=""
73 N PIECE,INACT S PIECE=$S('ICPTSTA:7,1:8),INACT=$S('ICPTSTA:1,1:"")
74 S $P(^DIC(81.3,DA(1),0),"^",5)=INACT,$P(^DIC(81.3,DA(1),0),"^",PIECE)=ICPTEFF
75 Q
76KHIS ; Kill Index ^DIC(81.3,"ACT",<code>,<status>,<date>,<ien>,<history>)
77 Q:+($G(DA(1)))'>0 Q:+($G(DA))'>0 Q:'$D(^DIC(81.3,+($G(DA(1))),60,+($G(DA)),0))
78 N PIECE,INACT,IEN,OPP,OPPSTA,OPPEFF,BOOL
79 S PIECE=$S('ICPTSTA:7,1:8),INACT=$S('ICPTSTA:"",1:1),OPPEFF=ICPTEFF,BOOL=0
80 F S OPPEFF=$O(^DIC(81.3,DA(1),60,"B",OPPEFF),-1) Q:'OPPEFF!BOOL D
81 . S IEN=$O(^DIC(81.3,DA(1),60,"B",OPPEFF,""))
82 . I 'IEN S OPPEFF="" Q
83 . S OPP=$G(^DIC(81.3,DA(1),60,IEN,0)),OPPEFF=$P($G(OPP),"^",1)
84 . S OPPSTA=$P($G(OPP),"^",2),BOOL=OPPSTA'=ICPTSTA
85 I BOOL D
86 . S $P(^DIC(81.3,DA(1),0),"^",5)=INACT,$P(^DIC(81.3,DA(1),0),"^",PIECE)=OPPEFF
87 E S $P(^DIC(81.3,DA(1),0),"^",5)=1,$P(^DIC(81.3,DA(1),0),"^",7,8)="^"
88 K ^DIC(81.3,"ACT",(ICPTMOD_" "),ICPTSTA,ICPTEFF,DA(1),DA)
89 Q
Note: See TracBrowser for help on using the repository browser.