1 | PXAPIDEL ;ISL/dee - PCE's code for the DELVFILE api ;11/4/96
|
---|
2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,9,22,130**;Aug 12, 1996
|
---|
3 | Q
|
---|
4 | ;
|
---|
5 | DELVFILE(PXAWHICH,PXAVISIT,PXAPKG,PXASOURC,PXAASK,PXAECHO,PXAUSER) ;Deletes the requesed data related to the visit.
|
---|
6 | ; PXAWHICH is a ^ delimited string with the last two or three letters
|
---|
7 | ; of the v-files to delete entries from and VISIT for the
|
---|
8 | ; administative data on the visit and STOP for the stop codes.
|
---|
9 | ; (e.g. for immunization the v-file is AUPNVIMM so IMM is
|
---|
10 | ; passed.) Or "ALL" to delete all of the data form the
|
---|
11 | ; V-Files, the Stop Code and Visit.
|
---|
12 | ; PXAVISIT is pointer to a visit for which the related data is be
|
---|
13 | ; deleted.
|
---|
14 | ; PACKAGE (optional) if passed will only delete items created by
|
---|
15 | ; this package
|
---|
16 | ; SOURCE (optional) if passed will only delete items created by
|
---|
17 | ; this source
|
---|
18 | ; PXAASK (optional) if passed and not 0 or "" then will ask the user
|
---|
19 | ; if they are sure that they want to delete
|
---|
20 | ; (suggest 1 if want to ask).
|
---|
21 | ; PXAECHO (optional) if passed and not 0 or "" then will display to
|
---|
22 | ; the user what is being deleted (suggest 1 if want to echo).
|
---|
23 | ; PXAUSER (optional) this is the duz of a user if you only want to
|
---|
24 | ; delete entries that this user created. If it is not passed
|
---|
25 | ; or is 0 or "" then it will not matter who created the
|
---|
26 | ; entries being deleted.
|
---|
27 | ;
|
---|
28 | ; Returns:
|
---|
29 | ; 1 if no errors and process completely
|
---|
30 | ; 0 if errors occurred
|
---|
31 | ; or try to delete something that was now allowed to delete
|
---|
32 | ; but deletion processed completely as possible
|
---|
33 | ; -1 if user said not to delete or user up arrows out
|
---|
34 | ; or errors out. In any case nothing was delete.
|
---|
35 | ; -2 if could not get a visit
|
---|
36 | ; -3 if called incorrectly
|
---|
37 | ; -4 if dependent entry count is still greater than zer0
|
---|
38 | ;
|
---|
39 | ;Good visit?
|
---|
40 | Q:'$G(PXAVISIT) -2
|
---|
41 | Q:'($D(^AUPNVSIT(PXAVISIT,0))#2) -2
|
---|
42 | ;
|
---|
43 | ;Get package pointer
|
---|
44 | S PACKAGE=$G(PACKAGE)
|
---|
45 | I PACKAGE="" S PXAPKG=0
|
---|
46 | E I PACKAGE=+PACKAGE S PXAPKG=PACKAGE
|
---|
47 | E S PXAPKG=$$PKG2IEN^VSIT(PACKAGE) I PXAPKG=-1 W:'$D(ZTQUEUED) !,"Procedure ""DELVFILE^PXAPI"" was called incorrectly without a valid ""PACKAGE"", contact IRM." Q -3
|
---|
48 | I PXAPKG>0,'($D(^DIC(9.4,PXAPKG,0))#2) W:'$D(ZTQUEUED) !,"Procedure ""DELVFILE^PXAPI"" was called incorrectly without a valid ""PACKAGE"", contact IRM." Q -3
|
---|
49 | ;
|
---|
50 | ;Lookup source in PCE DATA SOURCE file (#839.7) with LAYGO
|
---|
51 | S SOURCE=$G(SOURCE)
|
---|
52 | I SOURCE="" S PXASOURC=0
|
---|
53 | E I SOURCE=+SOURCE S PXASOURC=SOURCE
|
---|
54 | E S PXASOURC=$$SOURCE^PXAPIUTL(SOURCE)
|
---|
55 | I +PXASOURC=-1 W:'$D(ZTQUEUED) !,"Procedure ""DELVFILE^PXAPI"" was called incorrectly without a valid ""SOURCE"", contact IRM." Q -3
|
---|
56 | ;
|
---|
57 | K ^TMP("PXK",$J)
|
---|
58 | N PXACOUNT,PXAINDX,PXAVFILE,PXAFILE,PXARET,PXAWFLAG
|
---|
59 | N PXALEN,PXAIEN,PXAPIECE,PXAMYSOR
|
---|
60 | S PXARET=1
|
---|
61 | I PXAWHICH="ALL" S PXAWHICH="VISIT^STOP^CPT^IMM^PED^POV^PRV^SK^TRT^HF^XAM"
|
---|
62 | S PXALEN=$L(PXAWHICH,"^")
|
---|
63 | Q:PXALEN<1 -3
|
---|
64 | E F PXACOUNT=1:1:PXALEN S PXAVFILE=$P(PXAWHICH,"^",PXACOUNT) D Q:PXARET<0
|
---|
65 | . I "~VISIT~STOP~CPT~IMM~PED~POV~PRV~SK~TRT~HF~XAM~"'[("~"_PXAVFILE_"~") S PXARET=-3
|
---|
66 | Q:PXARET<0 PXARET
|
---|
67 | I PXAASK D Q:PXARET<0 PXARET
|
---|
68 | . N DIR,X,Y
|
---|
69 | . ;ask the user if they want to delete
|
---|
70 | . S DIR(0)="Y"
|
---|
71 | . S DIR("A")="Are you sure you want to delete the encounter information"
|
---|
72 | . S DIR("B")="NO"
|
---|
73 | . D ^DIR
|
---|
74 | . I Y'=1 S PXARET=-1 Q
|
---|
75 | S PXAMYSOR=$$SOURCE^PXAPIUTL("PCE DELETE V-FILES API")
|
---|
76 | ;Do Stop Codes first
|
---|
77 | S PXAWFLAG=PXAECHO&'$D(ZTQUEUED)
|
---|
78 | I "^"_PXAWHICH_"^"["^STOP^" D
|
---|
79 | . S PXAIEN=0
|
---|
80 | . F PXACOUNT=0:1 S PXAIEN=$O(^AUPNVSIT("AD",PXAVISIT,PXAIEN)) Q:'PXAIEN D
|
---|
81 | .. I PXAUSER>0,PXAUSER'=$P(^AUPNVSIT(PXAIEN,0),"^",23) Q
|
---|
82 | .. I PXAWFLAG S PXAWFLAG=0 W !," ...deleting Stop Codes"
|
---|
83 | .. I $$STOPCODE^PXUTLSTP(PXAMYSOR,"@",PXAVISIT,PXAIEN)
|
---|
84 | ;Set up the visit
|
---|
85 | S ^TMP("PXK",$J,"PKG")=PXAPKG
|
---|
86 | S ^TMP("PXK",$J,"SOR")=PXAMYSOR
|
---|
87 | S ^TMP("PXK",$J,"VST",1,"IEN")=PXAVISIT
|
---|
88 | F PXAPIECE=0,21,150,800,811 D
|
---|
89 | . S (^TMP("PXK",$J,"VST",1,PXAPIECE,"BEFORE"),^TMP("PXK",$J,"VST",1,PXAPIECE,"AFTER"))=$G(^AUPNVSIT(PXAVISIT,PXAPIECE))
|
---|
90 | ;
|
---|
91 | F PXACOUNT=1:1:PXALEN S PXAVFILE=$P(PXAWHICH,"^",PXACOUNT) D
|
---|
92 | . I PXAVFILE="VISIT" D
|
---|
93 | .. ;set fields to @
|
---|
94 | .. S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",18)="@"
|
---|
95 | .. F INDEX=1:1:7 S:$P(^TMP("PXK",$J,"VST",1,800,"AFTER"),"^",INDEX)]"" $P(^TMP("PXK",$J,"VST",1,800,"AFTER"),"^",INDEX)="@"
|
---|
96 | . E I PXAVFILE="STOP" ;skip already done
|
---|
97 | . E D ;the v-files
|
---|
98 | .. S PXAWFLAG=PXAECHO&'$D(ZTQUEUED)
|
---|
99 | .. S PXAFILE=$P($T(FORMAT^@("PXCE"_$S(PXAVFILE="IMM":"VIMM",1:PXAVFILE))),"~",5)
|
---|
100 | .. S PXAIEN=0
|
---|
101 | .. F PXAINDX=1:1 S PXAIEN=$O(@(PXAFILE_"(""AD"",PXAVISIT,PXAIEN)")) Q:'PXAIEN D
|
---|
102 | ... I $P($G(@(PXAFILE_"(PXAIEN,812)")),"^",1) S PXARET=0 Q
|
---|
103 | ... I PXAUSER>0,PXAUSER'=$P($P($P($G(@(PXAFILE_"(PXAIEN,801)")),"^",2),";",1)," ",2) Q
|
---|
104 | ... I PXAPKG>0,PXAPKG'=$P($G(@(PXAFILE_"(PXAIEN,812)")),"^",2) Q
|
---|
105 | ... I PXASOURC>0,PXASOURC'=$P($G(@(PXAFILE_"(PXAIEN,812)")),"^",3) Q
|
---|
106 | ... S ^TMP("PXK",$J,PXAVFILE,PXAINDX,0,"BEFORE")=@(PXAFILE_"(PXAIEN,0)")
|
---|
107 | ... S ^TMP("PXK",$J,PXAVFILE,PXAINDX,0,"AFTER")="@"
|
---|
108 | ... S ^TMP("PXK",$J,PXAVFILE,PXAINDX,"IEN")=PXAIEN
|
---|
109 | ... I PXAWFLAG D
|
---|
110 | .... S PXAWFLAG=0
|
---|
111 | .... W !," ...deleting "
|
---|
112 | .... W $S("CPT"=PXAVFILE:"Procedure","IMM"=PXAVFILE:"Immunizations","PED"=PXAVFILE:"Patient Education",1:"")
|
---|
113 | .... W $S("POV"=PXAVFILE:"Diagnoses","PRV"=PXAVFILE:"Providers","SK"=PXAVFILE:"Skin Test","TRT"=PXAVFILE:"Treatments","HF"=PXAVFILE:"Health Factors","XAM"=PXAVFILE:"Exams",1:"")
|
---|
114 | ;now process all the data except the stop codes which have already been done
|
---|
115 | N PXKERROR
|
---|
116 | I $D(^TMP("PXK",$J)) D
|
---|
117 | . I PXAECHO,'$D(ZTQUEUED) D WAIT^DICD
|
---|
118 | . D EN1^PXKMAIN
|
---|
119 | . D EVENT^PXKMAIN
|
---|
120 | . K ^TMP("PXK",$J)
|
---|
121 | N PXAKILL
|
---|
122 | I "^"_PXAWHICH_"^"["^VISIT^" D
|
---|
123 | . S PXAKILL=$$KILL^VSITKIL(PXAVISIT)
|
---|
124 | Q $S(PXARET=0!$D(PXKERROR):0,$G(PXAKILL):-4,1:1)
|
---|
125 | ;
|
---|