source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTMED.m@ 1073

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

revised back to 6/30/08 version

File size: 3.2 KB
RevLine 
[623]1PXRMTMED ; SLC/PKR/PJH - Edit a reminder term. ;01/30/2006
2 ;;2.0;CLINICAL REMINDERS;**1,4**;Feb 04, 2005;Build 21
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 STATUS=0
65 D DEF^PXRMRUTL("811.52",.DEF,.DEF1,.DEF2)
66 S NODE="^PXRMD(811.5)"
67 D LIST^PXRMREDT(NODE,DA,.LIST)
68 D DSPALL^PXRMREDF("T",NODE,DA,.LIST)
69 S DA(1)=DA
70 S IEN=DA
71 S DIC=DIE_DA(1)_",20,"
72 S DIC(0)="QEAL"
73 S DIC("A")="Select Finding: "
74 D ^DIC I Y=-1 S DTOUT=1,TCONT=0 Q
75 S DIE=DIC
76 S DA=+Y,GLOB=$P($P(Y,U,2),";",2) Q:GLOB=""
77 I GLOB="PXRMD(811.4," S CFIEN=$P($P(Y,U,2),";",1) D
78 .I $D(^PXRMD(811.4,CFIEN,1))>0 D
79 ..W !!,"Computed Finding Description:" S WPIEN=0
80 ..F S WPIEN=$O(^PXRMD(811.4,CFIEN,1,WPIEN)) Q:+WPIEN'>0 D
81 ...W !,$G(^PXRMD(811.4,CFIEN,1,WPIEN,0))
82 .E W !!,"No description defined for this computed finding"
83 .W !
84 W !,"Editing Finding Number: "_$G(DA)
85 ;Finding record fields
86 S DR=".01;9;12;17"
87 I GLOB="PXRMD(811.4," S DR=DR_";26"
88 ;Taxonomy - use inactive problems
89 I GLOB="PXD(811.2," D
90 .S TERMSTAT=$$TAXNODE^PXRMSTA1($P($P(Y,U,2),";"),"H")
91 .I TERMSTAT="P" S DR=DR_";10" Q
92 .I TERMSTAT'=0 S DR=DR_";10",STATUS=1
93 ;Health Factor - within category rank
94 I GLOB="AUTTHF(" S DR=DR_";11"
95 ;If V file INCLUDE VISIT DATA
96 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)
97 I VF S DR=DR_";28"
98 ;Mental Health - scale
99 I GLOB="YTT(601," S DR=DR_";13"
100 ;Radiology procedure
101 I GLOB="RAMIS(71," S STATUS=1
102 ;Orderable item
103 I GLOB="ORD(101.43," S DR=DR_";27",STATUS=1
104 ;Rx Type
105 I GLOB="PSDRUG("!(GLOB="PS(50.605,")!(GLOB="PSNDF(50.6,") S DR=DR_";16;27",STATUS=1
106 ;Condition
107 S DR=DR_";14;15;18"
108 ;
109 ;Edit finding record
110 D ^DIE
111 I STATUS=1,$D(DA)>0 D STATUS^PXRMSTA1(.DA,"T")
112 S $P(^PXRMD(811.5,IEN,20,0),U,3)=0
113 Q
114 ;
Note: See TracBrowser for help on using the repository browser.