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

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1PXCEVFIL ;ISL/dee - Main routine to edit a visit or v-file entry ;10/15/04 11:50am
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**9,30,22,73,88,89,104,147,124,169**;Aug 12, 1996
3 ;
4 Q
5EN(PXCECAT) ; -- main entry point for PXCE pxcecat EDIT
6 I PXCECAT="SIT"!(PXCECAT="HIST") D PATINFO^PXCEPAT(.PXCEPAT) Q:$D(DIRUT)
7 I PXCECAT'="SIT",PXCECAT'="APPM",PXCECAT'="HIST" Q:'$D(PXCEFIEN)!'$D(PXCEVIEN)!'$D(PXCEPAT)
8 E Q:(PXCEVIEW["P"&'$D(PXCEPAT))!(PXCEVIEW["H"&'$D(PXCEHLOC))!("~H~P~"'[("~"_$P(PXCEVIEW,"^")_"~"))
9 I PXCECAT="CSTP",$L($T(DATE^SCDXUTL)),$$DATE^SCDXUTL(+$G(^AUPNVSIT(PXCEVIEN,0))) W !!,$C(7),"Stop Codes can not be added to encounters after "_$$FMDATE^SCDXUTL Q
10 N PXCEQUIT
11 I "~CPT~CSTP~"[PXCECAT D Q:PXCEQUIT
12 . S PXCEQUIT=0
13 . I $P($G(^AUPNVSIT(PXCEVIEN,0)),"^",7)="E" D Q:$G(PXCEQUIT)
14 .. I PXCECAT="CSTP" W !!,$C(7),"Historical Encounters cannot have Stop Codes." D WAIT^PXCEHELP S PXCEQUIT=1 Q
15 K PXCEQUIT
16 D FULL^VALM1
17 ;
18 N PXCEVFIL,PXCELOOP,PXCENOER
19 N PXCECODE,PXCEAUPN,PXCECATS,PXCECATT,PXCEFILE
20 N PXCEPSCC
21 S PXCECATS=$S(PXCECAT="SIT":"VST",PXCECAT="APPM":"VST",PXCECAT="HIST":"VST",PXCECAT="CSTP":"VST",1:PXCECAT)
22 S PXCECODE="PXCE"_$S(PXCECAT="IMM":"VIMM",1:PXCECAT)
23 S PXCEAUPN=$P($T(FORMAT^@PXCECODE),"~",5)
24 S PXCECATT=$P($P($T(FORMAT^@PXCECODE),";;",2),"~",1)
25 S PXCEFILE=$P($T(FORMAT^@PXCECODE),"~",2)
26 S PXCEQUIT=0
27 I '$D(PXCAAFTR),PXCECAT'="SIT",PXCECAT'="APPM",PXCECAT'="HIST",PXCEFIEN'>0 D ASK^PXCEVFI2(PXCEVIEN,.PXCEFIEN,PXCEAUPN,PXCECATT,PXCECODE)
28 Q:PXCEQUIT
29 I PXCECAT'="SIT",PXCECAT'="APPM",PXCECAT'="HIST" S PXCELOOP=+PXCEFIEN
30 E S PXCELOOP=1,PXCEFIEN=PXCEVIEN
31 I PXCECAT="CSTP" D
32 . I $$VSTAPPT^PXUTL1(PXCEPAT,+^AUPNVSIT(PXCEVIEN,0),PXCEHLOC,PXCEVIEN) S PXCELOOP=0
33 . E S PXCELOOP=1
34 I $D(PXCAAFTR) S PXCELOOP=1
35 F D DOONE Q:PXCELOOP
36 K PXCEFIEN
37 Q
38 ;
39DOONE ;
40 N PXCEUP,PXELAP
41 N PXCEAFTR
42 D INIT
43 Q:PXCEQUIT
44DOONE2 ;
45 K PXKERROR
46 S PXCENOER=0
47 D EDIT^PXCEVFI1
48 I 'PXCEQUIT,PXCECAT="SIT",$P($G(PXCEAFTR(0)),"^")]"",$P($G(PXCEAFTR(0)),"^",22)]"" D
49 . I $D(^DPT(DFN,"S",$P(PXCEAFTR(0),"^"),0)),$P($G(^DPT(DFN,"S",$P(PXCEAFTR(0),"^"),0)),"^")=$P(PXCEAFTR(0),"^",22),$P(^DPT(DFN,"S",$P(PXCEAFTR(0),"^"),0),"^",2)["C" D
50 .. S PXCEQUIT=1,$P(PXCEAFTR(0),"^")=""
51 .. W !,$C(7),"Cannot create encounter for appointment date/time and clinic that was previously cancelled, NOTHING was STORED"
52 .. D WAIT^PXCEHELP
53 I ($P(PXCEAFTR(0),"^")]"") D
54 . I PXCEQUIT D
55 .. I 'PXCEFIEN,PXCECAT="CPT" D
56 ... D REMOVE(^TMP("PXK",$J,PXCECAT,1,"IEN"))
57 .. I 'PXCENOER D
58 ... I PXCEFIEN>0 D
59 .... D:PXCECAT="CPT" MODUPD
60 .... W !,$C(7),"The last entry did not have all of the required data and NOTHING was CHANGED."
61 ... E W !,$C(7),"The last entry did not have all of the required data and NOTHING was STORED."
62 ... D WAIT^PXCEHELP
63 . E D SAVE^PXCEVFI2
64 D EXIT
65 Q
66 ;
67INIT ; -- init variables and list array
68 N PXCENODS,PXCEFOR,PXCENODE
69 K ^TMP("PXK",$J),PXCEAFTR
70 S ^TMP("PXK",$J,"SOR")=PXCESOR
71 S ^TMP("PXK",$J,"VST",1,"IEN")=PXCEVIEN
72 I PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST") D
73 . I PXCEVIEN>0 L +@(PXCEAUPN_"(PXCEVIEN)"):5 E W !!,$C(7),"Cannot edit at this time, try again later." D PAUSE^PXCEHELP S PXCEQUIT=1 Q
74 . F PXCENODE=0,21,150,800,811,812 D
75 .. S PXCEAFTR(PXCENODE)=$S(PXCEVIEN>0:$G(^AUPNVSIT(PXCEVIEN,PXCENODE)),1:"")
76 .. S ^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")=PXCEAFTR(PXCENODE)
77 E D
78 . I PXCEFIEN>0 L +@(PXCEAUPN_"(PXCEFIEN)"):5 E W !!,$C(7),"Cannot edit at this time, try again later." D PAUSE^PXCEHELP S PXCEQUIT=1 Q
79 . F PXCENODE=0,21,150,800,811,812 D
80 .. S ^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")=$G(^AUPNVSIT(+PXCEVIEN,PXCENODE))
81 .. S ^TMP("PXK",$J,"VST",1,PXCENODE,"AFTER")=^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")
82 . ;
83 . S ^TMP("PXK",$J,PXCECATS,1,"IEN")=PXCEFIEN
84 . S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
85 . F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']"" D
86 .. I PXCEFIEN>0 D
87 ... I PXCECAT="CPT",PXCENODE=1 D
88 .... ;Retrieve CPT Modifiers from multiple field
89 .... S PXCESEQ=0
90 .... F S PXCESEQ=$O(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ)")) Q:'PXCESEQ D
91 ..... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")=$G(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ,0)"))
92 ..... S PXCEAFTR(PXCENODE,PXCESEQ)=^TMP("PXK",$J,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")
93 ... E D
94 .... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")=$G(@(PXCEAUPN_"(PXCEFIEN,PXCENODE)"))
95 .... S PXCEAFTR(PXCENODE)=^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")
96 .. E D
97 ... I PXCECAT="CPT",PXCENODE=1 D Q
98 .... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,1,"BEFORE")=""
99 ... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")=""
100 ... S PXCEAFTR(PXCENODE)=^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")
101 Q:PXCEQUIT
102 ;
103 I PXCEAUPN'="^AUPNVSIT" D
104 . ;Set the Patient and Visit pointers in the V-File.
105 . S:'$P(PXCEAFTR(0),"^",2) $P(PXCEAFTR(0),"^",2)=PXCEPAT
106 . S:'$P(PXCEAFTR(0),"^",3) $P(PXCEAFTR(0),"^",3)=PXCEVIEN
107 . I $P(PXCEAFTR(0),"^",1)="" D
108 .. S:'$P(PXCEAFTR(812),"^",2) $P(PXCEAFTR(812),"^",2)=PXCEPKG
109 .. S:'$P(PXCEAFTR(812),"^",3) $P(PXCEAFTR(812),"^",3)=PXCESOR
110 E D
111 . ;If new visit set package and source.
112 . I $P(PXCEAFTR(0),"^",1)="" D
113 .. S:'$P(PXCEAFTR(812),"^",2) $P(PXCEAFTR(812),"^",2)=PXCEPKG
114 .. S:'$P(PXCEAFTR(812),"^",3) $P(PXCEAFTR(812),"^",3)=PXCESOR
115 . ;Set the Patient in the Visit for new visit.
116 . I $G(PXCEAPDT)>0 D
117 .. S:'$P(PXCEAFTR(0),"^",1) $P(PXCEAFTR(0),"^",1)=PXCEAPDT
118 .. I '$P(PXCEAFTR(0),"^",21) D
119 ... ;Get the ELIGIBILITY for the appointment
120 ... N PXCEELIG
121 ... S PXCEELIG=$$ELIGIBIL^PXCEVSIT(PXCEPAT,PXCEHLOC,PXCEAPDT)
122 ... S:PXCEELIG>0 $P(PXCEAFTR(0),"^",21)=PXCEELIG
123 . S:'$P(PXCEAFTR(0),"^",5)&($G(PXCEPAT)>0) $P(PXCEAFTR(0),"^",5)=PXCEPAT
124 . S:'$P(PXCEAFTR(0),"^",22)&($G(PXCEHLOC)>0) $P(PXCEAFTR(0),"^",22)=PXCEHLOC
125 Q
126 ;
127EXIT ; -- exit code
128 I PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST") L:PXCEVIEN>0 -@(PXCEAUPN_"(PXCEVIEN)"):30
129 E L:PXCEFIEN>0 -@(PXCEAUPN_"(PXCEFIEN)"):30
130 S PXCEFIEN=""
131 K ^TMP("PXK",$J)
132 K PXCEAFTR
133 S PXCEQUIT=0
134 Q
135 ;
136MODUPD ;Update the MODIFIER list for the currently edited CPT code when all
137 ;the reqired data is not entered.
138 ;
139 N SQ,DA,DIC,DIK,X
140 S SQ=""
141 F S SQ=$O(PXCEAFTR(1,SQ)) Q:'SQ D
142 .S DA(1)=PXCEFIEN,DA=SQ
143 .S DIK="^AUPNVCPT("_DA(1)_","_1_","
144 .D ^DIK
145 F S SQ=$O(^TMP("PXK",$J,"CPT",1,1,SQ)) Q:'SQ D
146 .S X=^TMP("PXK",$J,"CPT",1,1,SQ,"BEFORE")
147 .Q:X']""
148 .K DD,DO
149 .S DA(1)=PXCEFIEN
150 .S DIC="^AUPNVCPT("_DA(1)_","_1_","
151 .S DIC(0)="L",DIC("P")=$P(^DD(9000010.18,1,0),"^",2)
152 .D FILE^DICN
153 Q
154 ;
155REMOVE(DA) ;REMOVE INCOMPLETE CPT ENTRY
156 N DIK
157 S DIK="^AUPNVCPT("
158 I $G(DA) D ^DIK ;PX*1*124
159 Q
Note: See TracBrowser for help on using the repository browser.