PXAPIDEL ;ISL/dee - PCE's code for the DELVFILE api ;06/02/2016
;;1.0;PCE PATIENT CARE ENCOUNTER;**1,9,22,130,168,197,216**;Aug 12, 1996;Build 11
Q
;
DELVFILE(PXAWHICH,PXAVISIT,PXAPKG,PXASOURC,PXAASK,PXAECHO,PXAUSER) ;Deletes the requested 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
; administrative 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 from 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^ICR" ; PX*1*216
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~ICR~"'[("~"_PXAVFILE_"~") S PXARET=-3 ; PX*1*216
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")
STOP ;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 $P($G(^AUPNVSIT(PXAIEN,150)),U,3)="C" Q ; do not delete credit stop code this time
.. I $P($G(^AUPNVSIT(PXAIEN,150)),U,3)'="S" Q ; delete only stop codes
.. I PXAWFLAG W !," ...deleting Stop Codes"
.. N PXST S PXST=$$STOPCODE^PXUTLSTP(PXAMYSOR,"@",PXAVISIT,PXAIEN) I PXST=-1 D
... I PXAWFLAG W !!,$C(7),"Cannot edit at this time, try again later." D PAUSE^PXCEHELP
;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:8 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","ICR"=PXAVFILE:"Contra/Refusal Event",1:"") ; PX*1*216
.... 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)
;
DELCR ;Do CREDIT Stop Code if it is the only entry except OE entry, not assoc. with apt
N SDD S SDD=$$VERAPT(PXAVISIT,.SDD) ; CHECK IF APPOINTMENT IS ASSOCIATED
I 'SDD D ; perform IF no appointment is associated with
.S PXAWFLAG=PXAECHO&'$D(ZTQUEUED)
.I "^"_PXAWHICH_"^"["^STOP^" D
..;VERIFY IF TO DELETE CREDIT STOP CODE AND IF SO THEN BE SURE PRIMARY VISIT WILL BE DELETED
..;
..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 $P($G(^AUPNVSIT(PXAIEN,150)),U,3)'="C" Q
...; check how many entries point to the primary visit
...N PXPCNT S PXPCNT=$$DEC^VSITKIL(PXAVISIT) ; CHECK COUNT OF PRIMARY VISIT
...; CONTINUE ONLY if there are less than three entries;
...; if there are 2 entries one of them would have to be OE
...; because if not OE then the second entry would be not PCE one
...; and the primary visit cannot be deleted
...I PXPCNT>2 Q ;
...I '$D(^SCE("AVSIT",PXAVISIT)) Q
...I PXAWFLAG W !," ...deleting Credit Stop Codes"
...N PXST S PXST=$$STOPCODE^PXUTLSTP(PXAMYSOR,"@",PXAVISIT,PXAIEN) I PXST=-1 D
....I PXAWFLAG W !!,$C(7),"Cannot edit/delete at this time, try again later." D PAUSE^PXCEHELP
;
N PXAKILL
I "^"_PXAWHICH_"^"["^VISIT^" D
. S PXAKILL=$$KILL^VSITKIL(PXAVISIT)
Q $S(PXARET=0!$D(PXKERROR):0,$G(PXAKILL):-4,1:1)
;
VERAPT(PXAVISIT,SCDXPOV) ;FUNCTION CALLED TO VERIFY IF VISIT IS ASSOCIATED WITH APPOINTMENT
N SDARRAY,SDCL,SDATE,SVSTSTR,SDFN,SCDXPOV,SDAPP
K ^TMP($J,"SDAMA301")
I '$D(^AUPNVSIT(PXAVISIT,0)) Q $G(SCDXPOV)
S SVSTSTR=^AUPNVSIT(PXAVISIT,0)
S SDCL=$P(SVSTSTR,U,22),SDATE=$P(SVSTSTR,U)
S SDARRAY(1)=SDATE_";"_SDATE,SDFN=$P(SVSTSTR,U,5)
S SDARRAY(4)=SDFN
S SDARRAY(2)=SDCL
S SDARRAY("FLDS")="2;12;16"
N SDCOUNT S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
I '$D(^TMP($J,"SDAMA301",SDFN,SDCL,SDATE)) Q $G(SCDXPOV)
S SDAPP=^TMP($J,"SDAMA301",SDFN,SDCL,SDATE)
N SDENC S SDENC=$P(SDAPP,U,12) ; OE
; get OE from VISIT
N SDOEP
K ^TMP($J,"SDAMA301")
D LISTVST^SDOERPC(.SDOEP,PXAVISIT)
S SDOEP=$P(SDOEP,")")_","_""""""_")"
S SDOEP=$O(@SDOEP)
I SDOEP>0 I SDENC=SDOEP S SCDXPOV=1 Q SCDXPOV ; active appointment is associated with this visit
Q $G(SCDXPOV)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAPIDEL 8475 printed Apr 07, 2021@15:32:35 Page 2
PXAPIDEL ;ISL/dee - PCE's code for the DELVFILE api ;06/02/2016
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,9,22,130,168,197,216**;Aug 12, 1996;Build 11
+2 QUIT
+3 ;
DELVFILE(PXAWHICH,PXAVISIT,PXAPKG,PXASOURC,PXAASK,PXAECHO,PXAUSER) ;Deletes the requested 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 ; administrative 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 from 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 ; PX*1*216
IF PXAWHICH="ALL"
SET PXAWHICH="VISIT^STOP^CPT^IMM^PED^POV^PRV^SK^TRT^HF^XAM^ICR"
+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 ; PX*1*216
IF "~VISIT~STOP~CPT~IMM~PED~POV~PRV~SK~TRT~HF~XAM~ICR~"'[("~"_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")
STOP ;Do Stop Codes first
+1 SET PXAWFLAG=PXAECHO&'$DATA(ZTQUEUED)
+2 IF "^"_PXAWHICH_"^"["^STOP^"
Begin DoDot:1
+3 SET PXAIEN=0
+4 FOR PXACOUNT=0:1
SET PXAIEN=$ORDER(^AUPNVSIT("AD",PXAVISIT,PXAIEN))
if 'PXAIEN
QUIT
Begin DoDot:2
+5 IF PXAUSER>0
IF PXAUSER'=$PIECE(^AUPNVSIT(PXAIEN,0),"^",23)
QUIT
+6 ; do not delete credit stop code this time
IF $PIECE($GET(^AUPNVSIT(PXAIEN,150)),U,3)="C"
QUIT
+7 ; delete only stop codes
IF $PIECE($GET(^AUPNVSIT(PXAIEN,150)),U,3)'="S"
QUIT
+8 IF PXAWFLAG
WRITE !," ...deleting Stop Codes"
+9 NEW PXST
SET PXST=$$STOPCODE^PXUTLSTP(PXAMYSOR,"@",PXAVISIT,PXAIEN)
IF PXST=-1
Begin DoDot:3
+10 IF PXAWFLAG
WRITE !!,$CHAR(7),"Cannot edit at this time, try again later."
DO PAUSE^PXCEHELP
End DoDot:3
End DoDot:2
End DoDot:1
+11 ;Set up the visit
+12 SET ^TMP("PXK",$JOB,"PKG")=PXAPKG
+13 SET ^TMP("PXK",$JOB,"SOR")=PXAMYSOR
+14 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXAVISIT
+15 FOR PXAPIECE=0,21,150,800,811
Begin DoDot:1
+16 SET (^TMP("PXK",$JOB,"VST",1,PXAPIECE,"BEFORE"),^TMP("PXK",$JOB,"VST",1,PXAPIECE,"AFTER"))=$GET(^AUPNVSIT(PXAVISIT,PXAPIECE))
End DoDot:1
+17 ;
+18 FOR PXACOUNT=1:1:PXALEN
SET PXAVFILE=$PIECE(PXAWHICH,"^",PXACOUNT)
Begin DoDot:1
+19 IF PXAVFILE="VISIT"
Begin DoDot:2
+20 ;set fields to @
+21 SET $PIECE(^TMP("PXK",$JOB,"VST",1,0,"AFTER"),"^",18)="@"
+22 FOR INDEX=1:1:8
if $PIECE(^TMP("PXK",$JOB,"VST",1,800,"AFTER"),"^",INDEX)]""
SET $PIECE(^TMP("PXK",$JOB,"VST",1,800,"AFTER"),"^",INDEX)="@"
End DoDot:2
+23 ;skip already done
IF '$TEST
IF PXAVFILE="STOP"
+24 ;the v-files
IF '$TEST
Begin DoDot:2
+25 SET PXAWFLAG=PXAECHO&'$DATA(ZTQUEUED)
+26 SET PXAFILE=$PIECE($TEXT(FORMAT^@("PXCE"_$SELECT(PXAVFILE="IMM":"VIMM",1:PXAVFILE))),"~",5)
+27 SET PXAIEN=0
+28 FOR PXAINDX=1:1
SET PXAIEN=$ORDER(@(PXAFILE_"(""AD"",PXAVISIT,PXAIEN)"))
if 'PXAIEN
QUIT
Begin DoDot:3
+29 IF $PIECE($GET(@(PXAFILE_"(PXAIEN,812)")),"^",1)
SET PXARET=0
QUIT
+30 IF PXAUSER>0
IF PXAUSER'=$PIECE($PIECE($PIECE($GET(@(PXAFILE_"(PXAIEN,801)")),"^",2),";",1)," ",2)
QUIT
+31 IF PXAPKG>0
IF PXAPKG'=$PIECE($GET(@(PXAFILE_"(PXAIEN,812)")),"^",2)
QUIT
+32 IF PXASOURC>0
IF PXASOURC'=$PIECE($GET(@(PXAFILE_"(PXAIEN,812)")),"^",3)
QUIT
+33 SET ^TMP("PXK",$JOB,PXAVFILE,PXAINDX,0,"BEFORE")=@(PXAFILE_"(PXAIEN,0)")
+34 SET ^TMP("PXK",$JOB,PXAVFILE,PXAINDX,0,"AFTER")="@"
+35 SET ^TMP("PXK",$JOB,PXAVFILE,PXAINDX,"IEN")=PXAIEN
+36 IF PXAWFLAG
Begin DoDot:4
+37 SET PXAWFLAG=0
+38 WRITE !," ...deleting "
+39 ; PX*1*216
WRITE $SELECT("CPT"=PXAVFILE:"Procedure","IMM"=PXAVFILE:"Immunizations","PED"=PXAVFILE:"Patient Education","ICR"=PXAVFILE:"Contra/Refusal Event",1:"")
+40 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
+41 ;now process all the data except the stop codes which have already been done
+42 ;
+43 ;
+44 NEW PXKERROR
+45 IF $DATA(^TMP("PXK",$JOB))
Begin DoDot:1
+46 IF PXAECHO
IF '$DATA(ZTQUEUED)
DO WAIT^DICD
+47 DO EN1^PXKMAIN
+48 DO EVENT^PXKMAIN
+49 KILL ^TMP("PXK",$JOB)
End DoDot:1
+50 ;
DELCR ;Do CREDIT Stop Code if it is the only entry except OE entry, not assoc. with apt
+1 ; CHECK IF APPOINTMENT IS ASSOCIATED
NEW SDD
SET SDD=$$VERAPT(PXAVISIT,.SDD)
+2 ; perform IF no appointment is associated with
IF 'SDD
Begin DoDot:1
+3 SET PXAWFLAG=PXAECHO&'$DATA(ZTQUEUED)
+4 IF "^"_PXAWHICH_"^"["^STOP^"
Begin DoDot:2
+5 ;VERIFY IF TO DELETE CREDIT STOP CODE AND IF SO THEN BE SURE PRIMARY VISIT WILL BE DELETED
+6 ;
+7 SET PXAIEN=0
+8 FOR PXACOUNT=0:1
SET PXAIEN=$ORDER(^AUPNVSIT("AD",PXAVISIT,PXAIEN))
if 'PXAIEN
QUIT
Begin DoDot:3
+9 IF PXAUSER>0
IF PXAUSER'=$PIECE(^AUPNVSIT(PXAIEN,0),"^",23)
QUIT
+10 IF $PIECE($GET(^AUPNVSIT(PXAIEN,150)),U,3)'="C"
QUIT
+11 ; check how many entries point to the primary visit
+12 ; CHECK COUNT OF PRIMARY VISIT
NEW PXPCNT
SET PXPCNT=$$DEC^VSITKIL(PXAVISIT)
+13 ; CONTINUE ONLY if there are less than three entries;
+14 ; if there are 2 entries one of them would have to be OE
+15 ; because if not OE then the second entry would be not PCE one
+16 ; and the primary visit cannot be deleted
+17 ;
IF PXPCNT>2
QUIT
+18 IF '$DATA(^SCE("AVSIT",PXAVISIT))
QUIT
+19 IF PXAWFLAG
WRITE !," ...deleting Credit Stop Codes"
+20 NEW PXST
SET PXST=$$STOPCODE^PXUTLSTP(PXAMYSOR,"@",PXAVISIT,PXAIEN)
IF PXST=-1
Begin DoDot:4
+21 IF PXAWFLAG
WRITE !!,$CHAR(7),"Cannot edit/delete at this time, try again later."
DO PAUSE^PXCEHELP
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+22 ;
+23 NEW PXAKILL
+24 IF "^"_PXAWHICH_"^"["^VISIT^"
Begin DoDot:1
+25 SET PXAKILL=$$KILL^VSITKIL(PXAVISIT)
End DoDot:1
+26 QUIT $SELECT(PXARET=0!$DATA(PXKERROR):0,$GET(PXAKILL):-4,1:1)
+27 ;
VERAPT(PXAVISIT,SCDXPOV) ;FUNCTION CALLED TO VERIFY IF VISIT IS ASSOCIATED WITH APPOINTMENT
+1 NEW SDARRAY,SDCL,SDATE,SVSTSTR,SDFN,SCDXPOV,SDAPP
+2 KILL ^TMP($JOB,"SDAMA301")
+3 IF '$DATA(^AUPNVSIT(PXAVISIT,0))
QUIT $GET(SCDXPOV)
+4 SET SVSTSTR=^AUPNVSIT(PXAVISIT,0)
+5 SET SDCL=$PIECE(SVSTSTR,U,22)
SET SDATE=$PIECE(SVSTSTR,U)
+6 SET SDARRAY(1)=SDATE_";"_SDATE
SET SDFN=$PIECE(SVSTSTR,U,5)
+7 SET SDARRAY(4)=SDFN
+8 SET SDARRAY(2)=SDCL
+9 SET SDARRAY("FLDS")="2;12;16"
+10 NEW SDCOUNT
SET SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
+11 IF '$DATA(^TMP($JOB,"SDAMA301",SDFN,SDCL,SDATE))
QUIT $GET(SCDXPOV)
+12 SET SDAPP=^TMP($JOB,"SDAMA301",SDFN,SDCL,SDATE)
+13 ; OE
NEW SDENC
SET SDENC=$PIECE(SDAPP,U,12)
+14 ; get OE from VISIT
+15 NEW SDOEP
+16 KILL ^TMP($JOB,"SDAMA301")
+17 DO LISTVST^SDOERPC(.SDOEP,PXAVISIT)
+18 SET SDOEP=$PIECE(SDOEP,")")_","_""""""_")"
+19 SET SDOEP=$ORDER(@SDOEP)
+20 ; active appointment is associated with this visit
IF SDOEP>0
IF SDENC=SDOEP
SET SCDXPOV=1
QUIT SCDXPOV
+21 QUIT $GET(SCDXPOV)
+22 ;
