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

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

initial load of WorldVistAEHR

File size: 5.7 KB
Line 
1PXAPIDEL ;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 ;
5DELVFILE(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 ;
Note: See TracBrowser for help on using the repository browser.