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