- 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 ;
