source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCEVFI2.m@ 1006

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1PXCEVFI2 ;ISL/dee,ESW - Supporting routines for editing a visit or v-file entry ; 4/24/07 4:27pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,73,95,96,124,158,184**;Aug 12, 1996;Build 30
3 ;
4 Q
5ASK(PXCVIEN,PXCFIEN,PXCEAUPN,PXCCATT,PXCCODE) ; -- Display a selection list from one V-File for this visit
6 N PXCEINDX,PXCECNT,PXCEASK,PXCEREF
7 N DIR,DA,X,Y
8 S PXCEINDX=""
9 F PXCECNT=0:1 S PXCEINDX=$O(@(PXCEAUPN_"(""AD"",PXCVIEN,PXCEINDX)")) Q:'PXCEINDX D
10 . I PXCECNT=0&(PXCCATT="Diagnosis") D SC($P(^AUPNVSIT(PXCEVIEN,0),U,5))
11 . I PXCECNT=0&(PXCCATT="CPT") D SC($P(^AUPNVSIT(PXCEVIEN,0),U,5))
12 . W:PXCECNT=0 !!,"--- "_PXCCATT_" ---",!
13 . S PXCEASK(PXCECNT+1)=PXCEINDX
14 . W !,$J(PXCECNT+1,3),?6,@("$$DISPLY01^"_PXCCODE_"("_PXCEAUPN_"(PXCEINDX,0))")
15 Q:PXCECNT'>0
16ASKLOOP S DIR(0)="FAO^1:"_$L(PXCECNT)
17 S DIR("A")="Enter 1-"_PXCECNT_" to Edit, or 'A' to Add: "
18 S DIR("?")="Enter the number of the "_PXCCATT_" you wish to edit or A to add a new "_PXCCATT_"."
19 D ^DIR
20 K DIR,DA
21 I $D(DIRUT) S PXCEQUIT=1 Q
22 Q:"Aa"[Y
23 G:Y<1!(Y>PXCECNT) ASKLOOP
24 G:$G(PXCEASK(Y))'>0 ASKLOOP
25 S PXCFIEN=$G(PXCEASK(Y))
26 Q
27 ;
28SAVE ; -- Save this edited and quit editing.
29 I PXCECAT="CSTP" S PXCEFIEN=$$STOPCODE^PXUTLSTP(PXCESOR,$P(PXCEAFTR(0),"^",8),PXCEVIEN)
30 E D
31 . N PXCENODS,PXCEFOR,PXCENODE,PXCESEQ
32 . S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
33 . F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']"" D
34 .. I PXCENODE=1,PXCECATS="CPT" D Q
35 ... S PXCESEQ=""
36 ... F S PXCESEQ=$O(PXCEAFTR(PXCENODE,PXCESEQ)) Q:PXCESEQ="" D
37 .... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,PXCESEQ,"AFTER")=PXCEAFTR(PXCENODE,PXCESEQ)
38 .. S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"AFTER")=PXCEAFTR(PXCENODE)
39 . I PXCECAT="SK",$G(^TMP("PXK",$J,PXCECATS,1,"IEN"))]"" D SAVE^PXCESK
40 . D EN1^PXKMAIN
41 . I PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST") S PXCEVIEN=^TMP("PXK",$J,"VST",1,"IEN")
42 Q
43 ;
44DEL(PXCECAT) ; -- Delete this V-File entry from the List if all the visit information.
45 I PXCEFIEN'>0!(PXCEVIEN'>0) W !!,$C(7),"Error: Cannot delete this an unknown V-File entry." D PAUSE^PXCEHELP Q
46 I PXCEKEYS'["D",PXCEKEYS'["d" W !!,$C(7),"Error: You do not have delete access." D PAUSE^PXCEHELP Q
47 ;
48 N PXCENODS,PXCEFOR,PXCENODE,PXCECATS,PXCECATT,PXCECODE,PXCEAUPN,PXCEQUIT
49 S PXCECODE="PXCE"_$S(PXCECAT="IMM":"VIMM",1:PXCECAT)
50 S PXCECATS=$S(PXCECAT="CSTP":"VST",PXCECAT="HIST":"VST",1:PXCECAT)
51 S PXCEAUPN=$P($T(FORMAT^@PXCECODE),"~",5)
52 S PXCECATT=$P($P($T(FORMAT^@PXCECODE),";;",2),"~",1)
53 ;
54 I '$D(@(PXCEAUPN_"(PXCEFIEN)")) Q
55 I $P($G(@(PXCEAUPN_"(PXCEFIEN,812)")),"^",1) D Q
56 . W !!,"Error on deleting "_PXCECATT_" ",@("$$DISPLY01^"_PXCECODE_"(@(PXCEAUPN_""(PXCEFIEN,0)""))")
57 . W !,"Error: You cannot delete this entry it has been ""Verified""." D WAIT^PXCEHELP
58 I PXCEKEYS'["D" D Q:PXCEQUIT
59 . N PXCECHK
60 . S PXCEQUIT=0
61 . I PXCECATS="VST" S PXCECHK=$P($G(@(PXCEAUPN_"(PXCEFIEN,0)")),"^",23)
62 . E S PXCECHK=$P($P($P($G(@(PXCEAUPN_"(PXCEFIEN,801)")),"^",2),";",1)," ",2)
63 . I DUZ'=PXCECHK D
64 .. S PXCEQUIT=1
65 .. N NODE0
66 .. S NODE0=@(PXCEAUPN_"(PXCEFIEN,0)")
67 .. W !!,"Error on deleting "_PXCECATT_" ",@("$$DISPLY01^"_PXCECODE_"(NODE0)")
68 .. W !,"Error: You cannot delete an entry you did not create." D WAIT^PXCEHELP
69 ;
70 I PXCECAT="CSTP" D
71 . W !!,"Deleting "_PXCECATT_" "
72 . W @("$$DISPLY01^"_PXCECODE_"($G(@(PXCEAUPN_""(PXCEFIEN,0)"")))")
73 . Q:'$$SURE^PXCEAE2
74 . N PXCERESU
75 . S PXCERESU=$$STOPCODE^PXUTLSTP(PXCESOR,"@",PXCEVIEN,PXCEFIEN)
76 . S:$D(PXCELOOP) PXCELOOP=1
77 E I PXCECATS="VST" D
78 . W !!,"Deleting "_PXCECATT_" "
79 . W @("$$DISPLY01^"_PXCECODE_"($G(@(PXCEAUPN_""(PXCEFIEN,0)"")))")
80 . Q:'$$SURE^PXCEAE2
81 . N PXCERESU
82 . S PXCERESU=$$KILL^VSITKIL(PXCEVIEN)
83 . I PXCERESU D
84 .. I PXCERESU=1,$O(^SCE("AVSIT",PXCEVIEN,"")) Q
85 .. W !,$C(7),"Could not delete the encounter. There are still users of it." D WAIT^PXCEHELP
86 . I 'PXCERESU S PXCEVDEL=1 S:$D(PXCELOOP) (PXCELOOP,PXCEQUIT,PXCENOER)=1
87 . D EVENT^PXKMAIN
88 ;
89 E D
90 . K ^TMP("PXK",$J)
91 . S ^TMP("PXK",$J,"VST",1,"IEN")=PXCEVIEN
92 . F PXCENODE=0,21,150,800,811,812 D
93 .. S (^TMP("PXK",$J,"VST",1,PXCENODE,"AFTER"),^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE"))=$G(^AUPNVSIT(PXCEVIEN,PXCENODE))
94 . ;
95 . S ^TMP("PXK",$J,"SOR")=PXCESOR
96 . S ^TMP("PXK",$J,PXCECATS,1,"IEN")=PXCEFIEN
97 . ;
98 . S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
99 . F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']"" D
100 .. S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")=$G(@(PXCEAUPN_"(PXCEFIEN,PXCENODE)"))
101 . ;
102 . N DIK,DA
103 . W !!,"Deleting "_PXCECATT_" "
104 . W @("$$DISPLY01^"_PXCECODE_"(^TMP(""PXK"",$J,PXCECATS,1,0,""BEFORE""))")
105 . Q:'$$SURE^PXCEAE2 ;DELQUIT
106 . S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
107 . F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']"" S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"AFTER")=$S(PXCENODE=0:"@",1:"")
108 . D EN1^PXKMAIN
109 . S:$D(PXCELOOP) PXCELOOP=1
110 . I $D(PXCENOER)#2 S PXCENOER=1
111 ;
112DELQUIT ;
113 K ^TMP("PXK",$J)
114 Q
115 ;
116SC(PXDFN) ;Service Connected Help
117 ; Input -- DFN Patient file IEN
118 ; Output -- Help
119 N I,SDCNT,SDDC,SDRD0
120 W !!,"Patient's Service Connection and Rated Disabilities:"
121 W !!,$S($P($G(^DPT(PXDFN,.3)),"^")="Y":" SC Percent: "_$P(^(.3),"^",2)_"%",1:" Service Connected: No")
122 W !,"Rated Disabilities: "
123 I $P($G(^DPT(PXDFN,"VET")),"^")'="Y",$S('$D(^DIC(391,+$G(^DPT(PXDFN,"TYPE")),0)):1,$P(^(0),"^",2):0,1:1) W "Not a Veteran" Q
124 S (SDCNT,I)=0
125 F S I=$O(^DPT(PXDFN,.372,I)) Q:'I I $P($G(^(I,0)),"^",3) S SDRD0=^(0) D
126 .S SDCNT=SDCNT+1
127 .S SDDC=$S('$D(^DIC(31,+SDRD0,0)):"",$P(^(0),"^",4)]"":$P(^(0),"^",4),1:$P(^(0),"^"))
128 .W:SDCNT>1 !
129 .W ?20,$P($G(^DIC(31,+SDRD0,0)),"^",3),?25,SDDC," (",$P(SDRD0,"^",2),"%-",$S($P(SDRD0,"^",3):"SC",1:""),")"
130 I 'SDCNT W $S('$O(^DPT(PXDFN,.372,0)):"None Stated",1:"No Service Connected Disabilities Listed")
131 ;
Note: See TracBrowser for help on using the repository browser.