source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCEVIMM.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1PXCEVIMM ;ISL/dee - Used to edit and display V IMMUNIZATION ;3/11/04 3:00pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**27,124**;Aug 12, 1996
3 ;; ;
4 Q
5 ;
6 ;Line with the line label "FORMAT"
7 ;;Long name~File Number~Node Subscripts~Allow Duplicate entries (1=yes, 0=no)~File global name
8 ; 1 2 3 4 5
9 ;
10 ;Followning lines:
11 ;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~
12 ; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
13 ;The Display & Edit routines are for special caces.
14 ; (The .01 field cannot have a special edit.)
15 ;
16FORMAT ;;Immunization~9000010.11~0,11,12,811,812~0~^AUPNVIMM
17 ;;0~1~.01~Immunization: ~Immunization: ~~~~~B
18 ;;12~4~1204~Encounter Provider: ~Encounter Provider: ~~EPROV12^PXCEPRV~~~D
19 ;;0~4~.04~Series: ~Series: ~~~~~D
20 ;;0~6~.06~Reaction: ~Reaction: ~~~~~D
21 ;;0~7~.07~Repeat Contraindicated: ~Repeat Contraindicated: ~~ECONTRAI^PXCEVIMM~~~D
22 ;;12~1~1201~Administered Date and (optional) Time~Administered Date and Time: ~~E1201^PXCEPOV1(0,30,30)~~~D
23 ;;811~1~81101~Comments: ~Comments: ~~~~~D
24 ;;0~8~.08~Diagnosis: ~Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCEVIMM~~~
25 ;;0~9~.09~Diagnosis 2: ~Diagnosis 2: ~$$DISPLY01^PXCEPOV~EPOV^PXCEVIMM~~~
26 ;;0~10~.1~Diagnosis 3: ~Diagnosis 3: ~$$DISPLY01^PXCEPOV~EPOV^PXCEVIMM~~~
27 ;;0~11~.11~Diagnosis 4: ~Diagnosis 4: ~$$DISPLY01^PXCEPOV~EPOV^PXCEVIMM~~~
28 ;;0~12~.12~Diagnosis 5: ~Diagnosis 5: ~$$DISPLY01^PXCEPOV~EPOV^PXCEVIMM~~~
29 ;;0~13~.13~Diagnosis 6: ~Diagnosis 6: ~$$DISPLY01^PXCEPOV~EPOV^PXCEVIMM~~~
30 ;;0~14~.14~Diagnosis 7: ~Diagnosis 7: ~$$DISPLY01^PXCEPOV~EPOV^PXCEVIMM~~~
31 ;;0~15~.15~Diagnosis 8: ~Diagnosis 8: ~$$DISPLY01^PXCEPOV~EPOV^PXCEVIMM~~~
32 ;;
33 ;
34 ;Cannot ask work processing
35 ;;12~2~1202~Ordering Provider: ~Ordering Provider: ~~EPROV12^PXCEPRV~~~D
36 ;
37 ;The interface for AICS to get list on form for help.
38INTRFACE ;;PX SELECT IMMUNIZATIONS
39 ;
40 ;********************************
41 ;Special cases for display.
42 ;
43 ;********************************
44 ;Special cases for edit.
45 ;
46ECONTRAI ;
47 I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
48 . N DIERR,PXCEDILF,PXCEINT,PXCEEXT
49 . S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
50 . S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
51 . S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
52 E S DIR("B")="NO"
53 S DIR(0)=PXCEFILE_","_$P(PXCETEXT,"~",3)_"A"
54 S DIR("A")=$P(PXCETEXT,"~",4)
55 S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
56 D ^DIR
57 K DIR,DA
58 I X="@" S Y="@"
59 E I $D(DTOUT)!$D(DUOUT) S PXCEEND=1 Q
60 S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
61 Q
62 ;
63ELOT ;
64 I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
65 . N DIERR,PXCEDILF,PXCEINT,PXCEEXT
66 . S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
67 . S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
68 . S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
69 S DIR(0)="PAO^9999999.41:EM^K:$P(^(0),U,3)'=0!($P(^(0),U,4)'=$P(PXCEAFTR(0),U,1)) X"
70 S DIR("A")=$P(PXCETEXT,"~",4)
71 S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
72 D ^DIR
73 K DIR,DA
74 I X="@" S Y="@"
75 E I $D(DTOUT)!$D(DUOUT) S PXCEEND=1 Q
76 S:Y'<0 $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
77 Q
78 ;
79 ;
80EPOV ;Edit the Associated DX
81 I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
82 .N DIERR,PXCEDILF,PXCEINT,PXCEEXT
83 .S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
84 .S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
85 .S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
86 S DIR(0)=PXCEFILE_","_$P(PXCETEXT,"~",3)_"A"
87 S DIR("A")=$P(PXCETEXT,"~",4)
88 S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
89 D ^DIR
90 K DIR,DA
91 I X="@" S Y="@" S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^") Q
92 I $D(DTOUT)!$D(DUOUT) S PXCEEND=1,PXCEQUIT=1 Q
93 I '+Y S PXCEEND=1 Q ;S:$P(PXCETEXT,"~",3)=".08" PXCEQUIT=1 Q
94 ;See if this diagnosis is in the PXCEAFTR(0)
95 I $P(PXCETEXT,"~",2)'=8,(+Y=$P($G(PXCEAFTR(0)),"^",8)) S PXCEEND=1
96 I $P(PXCETEXT,"~",2)'=9,(+Y=$P($G(PXCEAFTR(0)),"^",9)) S PXCEEND=1
97 I $P(PXCETEXT,"~",2)'=10,(+Y=$P($G(PXCEAFTR(0)),"^",10)) S PXCEEND=1
98 I $P(PXCETEXT,"~",2)'=11,(+Y=$P($G(PXCEAFTR(0)),"^",11)) S PXCEEND=1
99 I $P(PXCETEXT,"~",2)'=12,(+Y=$P($G(PXCEAFTR(0)),"^",12)) S PXCEEND=1
100 I $P(PXCETEXT,"~",2)'=13,(+Y=$P($G(PXCEAFTR(0)),"^",13)) S PXCEEND=1
101 I $P(PXCETEXT,"~",2)'=14,(+Y=$P($G(PXCEAFTR(0)),"^",14)) S PXCEEND=1
102 I $P(PXCETEXT,"~",2)'=15,(+Y=$P($G(PXCEAFTR(0)),"^",15)) S PXCEEND=1
103 I PXCEEND=1 W !,$C(7),"Duplicate Diagnosis on this CPT code is not allowed." D WAIT^PXCEHELP Q
104 S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
105 D:+Y>0 DIAGNOS^PXCEVFI4(+Y)
106 Q
107 ;
108 ;********************************
109 ;Display text for the .01 field which is a pointer to Immunization.
110 ;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
111DISPLY01(PXCEIMM) ;
112 N DIERR,PXCEDILF,PXCEINT,PXCEEXT
113 S PXCEINT=$P(PXCEIMM,"^",1)
114 S PXCEEXT=$$EXTERNAL^DILFD(9000010.11,.01,"",PXCEINT,"PXCEDILF")
115 Q $S('$D(DIERR):PXCEEXT,1:PXCEINT)
116 ;
Note: See TracBrowser for help on using the repository browser.