source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTMED.m@ 1423

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

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1PXRMTMED ; SLC/PKR/PJH - Edit a reminder term. ;04/18/2007
2 ;;2.0;CLINICAL REMINDERS;**1,4,6**;Feb 04, 2005;Build 123
3 ;
4 ;=======================================================
5 N CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,Y
6GETNAME ;Get the name of the term to edit.
7 K DA,DIC,DLAYGO,DTOUT,DUOUT,Y
8 S DIC="^PXRMD(811.5,"
9 S DIC(0)="AEMQL"
10 S DIC("A")="Select Reminder Term: "
11 S DLAYGO=811.5
12 ;Set the starting place for additions.
13 D SETSTART^PXRMCOPY(DIC)
14 W !
15 D ^DIC
16 I ($D(DTOUT))!($D(DUOUT)) Q
17 I Y=-1 G END
18 S DA=$P(Y,U,1)
19 S CS1=$$FILE^PXRMEXCS(811.5,DA)
20 D EDIT(DIC,DA)
21 I $G(DA)="" G GETNAME
22 S CS2=$$FILE^PXRMEXCS(811.5,DA)
23 I CS2=0 G GETNAME
24 I CS2'=CS1 D SEHIST^PXRMUTIL(811.5,DIC,DA)
25 G GETNAME
26END ;
27 Q
28 ;
29 ;=======================================================
30CLASS(DA,DIE) ;
31 N DR,RESULT,X,Y
32RETRY W !
33 S DR="100" D ^DIE I $D(Y) Q
34 ;Sponsor
35 S DR="101" D ^DIE I $D(Y) Q
36 ;Make sure Class and Sponsor Class are in synch.
37 S RESULT=$$VSPONSOR^PXRMINTR(X)
38 I RESULT=0 S DIE("NO^")="Other value" G RETRY
39 I RESULT=1 K DIE("NO^")
40 ;Review date, Usage
41 S DR="102;1" D ^DIE I $D(Y) Q
42 Q
43 ;
44 ;=======================================================
45EDIT(ROOT,DA) ;
46 N CLASS,DIC,DIE,DR,DIDEL,PXRMTMD,RESULT,TCONT,Y
47 ;PXRMTMD is set by a xref on the .01 as a flag that the entire
48 ;entry is being deleted.
49 S CLASS=$P($G(^PXRMD(811.5,DA,100)),U,1)
50 S DIE=ROOT
51 I CLASS'="N"!(($G(PXRMINST)=1)&($G(DUZ(0))="@")) D
52 . S DR=".01"
53 . D ^DIE
54 . I $G(DA)'="" D CLASS(DA,DIE)
55 I $G(DA)="" Q
56 S TCONT=1
57 F D FINDING(DIE,DA) Q:TCONT=0
58 Q
59 ;
60 ;=======================================================
61FINDING(DIE,DA,LIST) ;
62 N CFIEN,GLOB,IEN,LIST,NODE,TERMSTAT,VF,WPIEN
63 N DEF,DEF1,DEF2,STATUS
64 S DIE("NO^")="OUTOK"
65 S STATUS=0
66 D DEF^PXRMRUTL("811.52",.DEF,.DEF1,.DEF2)
67 S NODE="^PXRMD(811.5)"
68 D LIST^PXRMREDT(NODE,DA,.LIST)
69 D DSPALL^PXRMREDF("T",NODE,DA,.LIST)
70 S DA(1)=DA
71 S IEN=DA
72 S DIC=DIE_DA(1)_",20,"
73 S DIC(0)="QEAL"
74 S DIC("A")="Select Finding: "
75 D ^DIC I Y=-1 S DTOUT=1,TCONT=0 Q
76 S DIE=DIC
77 S DA=+Y,GLOB=$P($P(Y,U,2),";",2) Q:GLOB=""
78 I GLOB="PXRMD(811.4," S CFIEN=$P($P(Y,U,2),";",1) D
79 . I $D(^PXRMD(811.4,CFIEN,1))>0 D
80 .. W !!,"Computed Finding Description:" S WPIEN=0
81 .. F S WPIEN=$O(^PXRMD(811.4,CFIEN,1,WPIEN)) Q:+WPIEN'>0 D
82 ... W !,$G(^PXRMD(811.4,CFIEN,1,WPIEN,0))
83 . E W !!,"No description defined for this computed finding"
84 . W !
85 I GLOB="YTT(601.71," D WARN^PXRMMH
86 W !,"Editing Finding Number: "_$G(DA)
87 ;Finding record fields
88 S DR=".01;9;12;17"
89 I GLOB="PXRMD(811.4," S DR=DR_";26"
90 ;Taxonomy - use inactive problems
91 I GLOB="PXD(811.2," D
92 .S TERMSTAT=$$TAXNODE^PXRMSTA1($P($P(Y,U,2),";"),"H")
93 .I TERMSTAT="P" S DR=DR_";10" Q
94 .I TERMSTAT'=0 S DR=DR_";10",STATUS=1
95 ;Health Factor - within category rank
96 I GLOB="AUTTHF(" S DR=DR_";11"
97 ;If V file INCLUDE VISIT DATA
98 S VF=$S(GLOB["AUTTEDT":1,GLOB["AUTTEXAM":1,GLOB["AUTTHF":1,GLOB["AUTTIMM":1,GLOB="AUTTSK":1,GLOB["PXD(811.2":1,1:0)
99 I VF S DR=DR_";28"
100 ;Mental Health - scale
101 I GLOB="YTT(601.71," S DR=DR_";13"
102 ;Radiology procedure
103 I GLOB="RAMIS(71," S STATUS=1
104 ;Orderable item
105 I GLOB="ORD(101.43," S DR=DR_";27",STATUS=1
106 ;Rx Type
107 I GLOB="PSDRUG("!(GLOB="PS(50.605,")!(GLOB="PSNDF(50.6,") S DR=DR_";16;27",STATUS=1
108 ;Condition
109 S DR=DR_";14;15;18"
110 ;
111 ;Edit finding record
112 D ^DIE
113 I STATUS=1,$D(DA)>0,$D(Y)=0 D STATUS^PXRMSTA1(.DA,"T")
114 S $P(^PXRMD(811.5,IEN,20,0),U,3)=0
115 Q
116 ;
Note: See TracBrowser for help on using the repository browser.