PXAPIDEL ;ISL/dee - PCE's code for the DELVFILE api ;Dec 19, 2018@07:53:52
;;1.0;PCE PATIENT CARE ENCOUNTER;**1,9,22,130,168,197,216,211,217**;Aug 12, 1996;Build 134
Q
;
DELVFILE(PXAWHICH,PXAVISIT,PXAPKG,PXASOURC,PXAASK,PXAECHO,PXAUSER,ERRRET,PXAPROB) ;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.
; ERRRET (optional) passed by reference. If present will return PXKERROR
; array elements to the caller.
; PXAPROB (optional) A dotted variable name. When errors and warnings
; occur, They will be passed back in the form of an array
; with the general description of the problem.
;
; 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 deleted.
; -2 if could not get a visit
; -3 if called incorrectly
; -4 if dependent entry count is still greater than zero
; -5 if encounter cannot be locked
;
N PXERRCNT,PXERRMSG
;
S PXERRCNT=0
;
;Good visit?
I '$G(PXAVISIT) D Q -2
. D ADDERR("A pointer to the Visit must be passed in.")
I '($D(^AUPNVSIT(PXAVISIT,0))#2) D Q -2
. D ADDERR(PXAVISIT_" is not a valid Visit IEN.")
;
;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 D Q -3
. S PXERRMSG="Procedure ""DELVFILE^PXAPI"" was called incorrectly without a valid ""PACKAGE"", contact IRM."
. W:'$D(ZTQUEUED) !,PXERRMSG
. D ADDERR(PXERRMSG)
I PXAPKG>0,'($D(^DIC(9.4,PXAPKG,0))#2) D Q -3
. S PXERRMSG="Procedure ""DELVFILE^PXAPI"" was called incorrectly without a valid ""PACKAGE"", contact IRM."
. W:'$D(ZTQUEUED) !,PXERRMSG
. D ADDERR(PXERRMSG)
;
;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 D Q -3
. S PXERRMSG="Procedure ""DELVFILE^PXAPI"" was called incorrectly without a valid ""SOURCE"", contact IRM."
. W:'$D(ZTQUEUED) !,PXERRMSG
. D ADDERR(PXERRMSG)
;
K ^TMP("PXK",$J)
N INDEX,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^SC" ; 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~SC~"'[("~"_PXAVFILE_"~") D
. . S PXARET=-3
. . D ADDERR(""""_PXAVFILE_""" is not a valid reference to a V file.")
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
I PXARET-1 Q -1
S PXAWFLAG=PXAECHO&'$D(ZTQUEUED)
;Lock the encounter before doing any deletions.
N ERROR,LOCK
S LOCK=$$LOCK^PXLOCK(PXAVISIT,DUZ,2,.ERROR,"PXAPIDEL")
I LOCK=0 D Q -5
. I PXAWFLAG W !,ERROR("LOCK")
. D ADDERR($G(ERROR("LOCK")))
S PXAMYSOR=$$SOURCE^PXAPIUTL("PCE DELETE V-FILES API")
STOP ;Do Stop Codes first
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
... D ADDERR("Was not able to delete secondary stop code visit (#"_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: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 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
... ; Check to see if there is a skin test reading linked to this entry
... I PXAVFILE="SK",$D(^AUPNVSK("APT",PXAIEN)) D Q
.... S PXARET=0
.... S PXERRMSG="Could not delete V SKIN TEST entry (#"_PXAIEN_") as there is a reading "
.... S PXERRMSG=PXERRMSG_"skin test linked to it. You must first delete the reading skin test."
.... D ADDERR(PXERRMSG)
... I $P($G(@(PXAFILE_"(PXAIEN,812)")),"^",1) D Q
.... S PXARET=0
.... D ADDERR("Could not delete this "_PXAVFILE_" entry (#"_PXAIEN_") as this event was electronically signed.")
... 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:"")
.... W $S("SC"=PXAVFILE:"Standard Codes",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
. M ERRRET=PXKERROR
. D EVENT^PXKMAIN
. K ^TMP("PXK",$J),PXKERROR
;
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
....D ADDERR("Was not able to delete secondary stop code visit (#"_PXAIEN_").")
;
N PXAKILL
I "^"_PXAWHICH_"^"["^VISIT^" D
. S PXAKILL=$$KILL^VSITKIL(PXAVISIT)
. I PXAKILL>0 D
.. S PXERRMSG="There are still "_PXAKILL_" entries pointing to this Visit. "
.. S PXERRMSG=PXERRMSG_"Therefore, the Visit could not be deleted."
.. D ADDERR(PXERRMSG)
D UNLOCK^PXLOCK(PXAVISIT,DUZ,"PXAPIDEL")
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)
;If the hospital location is null there cannot be an appointment.
I SDCL="" Q $G(SCDXPOV)
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)
;
ADDERR(PXMSG) ;
S PXERRCNT=PXERRCNT+1
S PXAPROB(PXERRCNT)=PXMSG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAPIDEL 10632 printed Apr 09, 2024@21:33 Page 2
PXAPIDEL ;ISL/dee - PCE's code for the DELVFILE api ;Dec 19, 2018@07:53:52
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,9,22,130,168,197,216,211,217**;Aug 12, 1996;Build 134
+2 QUIT
+3 ;
DELVFILE(PXAWHICH,PXAVISIT,PXAPKG,PXASOURC,PXAASK,PXAECHO,PXAUSER,ERRRET,PXAPROB) ;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 ; ERRRET (optional) passed by reference. If present will return PXKERROR
+23 ; array elements to the caller.
+24 ; PXAPROB (optional) A dotted variable name. When errors and warnings
+25 ; occur, They will be passed back in the form of an array
+26 ; with the general description of the problem.
+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 deleted.
+35 ; -2 if could not get a visit
+36 ; -3 if called incorrectly
+37 ; -4 if dependent entry count is still greater than zero
+38 ; -5 if encounter cannot be locked
+39 ;
+40 NEW PXERRCNT,PXERRMSG
+41 ;
+42 SET PXERRCNT=0
+43 ;
+44 ;Good visit?
+45 IF '$GET(PXAVISIT)
Begin DoDot:1
+46 DO ADDERR("A pointer to the Visit must be passed in.")
End DoDot:1
QUIT -2
+47 IF '($DATA(^AUPNVSIT(PXAVISIT,0))#2)
Begin DoDot:1
+48 DO ADDERR(PXAVISIT_" is not a valid Visit IEN.")
End DoDot:1
QUIT -2
+49 ;
+50 ;Get package pointer
+51 SET PACKAGE=$GET(PACKAGE)
+52 IF PACKAGE=""
SET PXAPKG=0
+53 IF '$TEST
IF PACKAGE=+PACKAGE
SET PXAPKG=PACKAGE
+54 IF '$TEST
SET PXAPKG=$$PKG2IEN^VSIT(PACKAGE)
IF PXAPKG=-1
Begin DoDot:1
+55 SET PXERRMSG="Procedure ""DELVFILE^PXAPI"" was called incorrectly without a valid ""PACKAGE"", contact IRM."
+56 if '$DATA(ZTQUEUED)
WRITE !,PXERRMSG
+57 DO ADDERR(PXERRMSG)
End DoDot:1
QUIT -3
+58 IF PXAPKG>0
IF '($DATA(^DIC(9.4,PXAPKG,0))#2)
Begin DoDot:1
+59 SET PXERRMSG="Procedure ""DELVFILE^PXAPI"" was called incorrectly without a valid ""PACKAGE"", contact IRM."
+60 if '$DATA(ZTQUEUED)
WRITE !,PXERRMSG
+61 DO ADDERR(PXERRMSG)
End DoDot:1
QUIT -3
+62 ;
+63 ;Lookup source in PCE DATA SOURCE file (#839.7) with LAYGO
+64 SET SOURCE=$GET(SOURCE)
+65 IF SOURCE=""
SET PXASOURC=0
+66 IF '$TEST
IF SOURCE=+SOURCE
SET PXASOURC=SOURCE
+67 IF '$TEST
SET PXASOURC=$$SOURCE^PXAPIUTL(SOURCE)
+68 IF +PXASOURC=-1
Begin DoDot:1
+69 SET PXERRMSG="Procedure ""DELVFILE^PXAPI"" was called incorrectly without a valid ""SOURCE"", contact IRM."
+70 if '$DATA(ZTQUEUED)
WRITE !,PXERRMSG
+71 DO ADDERR(PXERRMSG)
End DoDot:1
QUIT -3
+72 ;
+73 KILL ^TMP("PXK",$JOB)
+74 NEW INDEX,PXACOUNT,PXAINDX,PXAVFILE,PXAFILE,PXARET,PXAWFLAG
+75 NEW PXALEN,PXAIEN,PXAPIECE,PXAMYSOR
+76 SET PXARET=1
+77 ; PX*1*216
IF PXAWHICH="ALL"
SET PXAWHICH="VISIT^STOP^CPT^IMM^PED^POV^PRV^SK^TRT^HF^XAM^ICR^SC"
+78 SET PXALEN=$LENGTH(PXAWHICH,"^")
+79 if PXALEN<1
QUIT -3
+80 IF '$TEST
FOR PXACOUNT=1:1:PXALEN
SET PXAVFILE=$PIECE(PXAWHICH,"^",PXACOUNT)
Begin DoDot:1
+81 IF "~VISIT~STOP~CPT~IMM~PED~POV~PRV~SK~TRT~HF~XAM~ICR~SC~"'[("~"_PXAVFILE_"~")
Begin DoDot:2
+82 SET PXARET=-3
+83 DO ADDERR(""""_PXAVFILE_""" is not a valid reference to a V file.")
End DoDot:2
End DoDot:1
if PXARET<0
QUIT
+84 if PXARET<0
QUIT PXARET
+85 IF PXAASK
Begin DoDot:1
+86 NEW DIR,X,Y
+87 ;ask the user if they want to delete
+88 SET DIR(0)="Y"
+89 SET DIR("A")="Are you sure you want to delete the encounter information"
+90 SET DIR("B")="NO"
+91 DO ^DIR
+92 IF Y'=1
SET PXARET=-1
QUIT
End DoDot:1
if PXARET<0
QUIT PXARET
+93 IF PXARET-1
QUIT -1
+94 SET PXAWFLAG=PXAECHO&'$DATA(ZTQUEUED)
+95 ;Lock the encounter before doing any deletions.
+96 NEW ERROR,LOCK
+97 SET LOCK=$$LOCK^PXLOCK(PXAVISIT,DUZ,2,.ERROR,"PXAPIDEL")
+98 IF LOCK=0
Begin DoDot:1
+99 IF PXAWFLAG
WRITE !,ERROR("LOCK")
+100 DO ADDERR($GET(ERROR("LOCK")))
End DoDot:1
QUIT -5
+101 SET PXAMYSOR=$$SOURCE^PXAPIUTL("PCE DELETE V-FILES API")
STOP ;Do Stop Codes first
+1 IF "^"_PXAWHICH_"^"["^STOP^"
Begin DoDot:1
+2 SET PXAIEN=0
+3 FOR PXACOUNT=0:1
SET PXAIEN=$ORDER(^AUPNVSIT("AD",PXAVISIT,PXAIEN))
if 'PXAIEN
QUIT
Begin DoDot:2
+4 IF PXAUSER>0
IF PXAUSER'=$PIECE(^AUPNVSIT(PXAIEN,0),"^",23)
QUIT
+5 ; do not delete credit stop code this time
IF $PIECE($GET(^AUPNVSIT(PXAIEN,150)),U,3)="C"
QUIT
+6 ; delete only stop codes
IF $PIECE($GET(^AUPNVSIT(PXAIEN,150)),U,3)'="S"
QUIT
+7 IF PXAWFLAG
WRITE !," ...deleting Stop Codes"
+8 NEW PXST
SET PXST=$$STOPCODE^PXUTLSTP(PXAMYSOR,"@",PXAVISIT,PXAIEN)
IF PXST=-1
Begin DoDot:3
+9 IF PXAWFLAG
WRITE !!,$CHAR(7),"Cannot edit at this time, try again later."
DO PAUSE^PXCEHELP
+10 DO ADDERR("Was not able to delete secondary stop code visit (#"_PXAIEN_").")
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 PXAUSER>0
IF PXAUSER'=$PIECE($PIECE($PIECE($GET(@(PXAFILE_"(PXAIEN,801)")),"^",2),";",1)," ",2)
QUIT
+30 IF PXAPKG>0
IF PXAPKG'=$PIECE($GET(@(PXAFILE_"(PXAIEN,812)")),"^",2)
QUIT
+31 IF PXASOURC>0
IF PXASOURC'=$PIECE($GET(@(PXAFILE_"(PXAIEN,812)")),"^",3)
QUIT
+32 ; Check to see if there is a skin test reading linked to this entry
+33 IF PXAVFILE="SK"
IF $DATA(^AUPNVSK("APT",PXAIEN))
Begin DoDot:4
+34 SET PXARET=0
+35 SET PXERRMSG="Could not delete V SKIN TEST entry (#"_PXAIEN_") as there is a reading "
+36 SET PXERRMSG=PXERRMSG_"skin test linked to it. You must first delete the reading skin test."
+37 DO ADDERR(PXERRMSG)
End DoDot:4
QUIT
+38 IF $PIECE($GET(@(PXAFILE_"(PXAIEN,812)")),"^",1)
Begin DoDot:4
+39 SET PXARET=0
+40 DO ADDERR("Could not delete this "_PXAVFILE_" entry (#"_PXAIEN_") as this event was electronically signed.")
End DoDot:4
QUIT
+41 SET ^TMP("PXK",$JOB,PXAVFILE,PXAINDX,0,"BEFORE")=@(PXAFILE_"(PXAIEN,0)")
+42 SET ^TMP("PXK",$JOB,PXAVFILE,PXAINDX,0,"AFTER")="@"
+43 SET ^TMP("PXK",$JOB,PXAVFILE,PXAINDX,"IEN")=PXAIEN
+44 IF PXAWFLAG
Begin DoDot:4
+45 SET PXAWFLAG=0
+46 WRITE !," ...deleting "
+47 ; PX*1*216
WRITE $SELECT("CPT"=PXAVFILE:"Procedure","IMM"=PXAVFILE:"Immunizations","PED"=PXAVFILE:"Patient Education","ICR"=PXAVFILE:"Contra/Refusal Event",1:"")
+48 WRITE $SELECT("POV"=PXAVFILE:"Diagnoses","PRV"=PXAVFILE:"Providers","SK"=PXAVFILE:"Skin Test","TRT"=PXAVFILE:"Treatments","HF"=PXAVFILE:"Health Factors","XAM"=PXAVFILE:"Exams",1:"")
+49 WRITE $SELECT("SC"=PXAVFILE:"Standard Codes",1:"")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+50 ;now process all the data except the stop codes which have already been done
+51 ;
+52 NEW PXKERROR
+53 IF $DATA(^TMP("PXK",$JOB))
Begin DoDot:1
+54 IF PXAECHO
IF '$DATA(ZTQUEUED)
DO WAIT^DICD
+55 DO EN1^PXKMAIN
+56 MERGE ERRRET=PXKERROR
+57 DO EVENT^PXKMAIN
+58 KILL ^TMP("PXK",$JOB),PXKERROR
End DoDot:1
+59 ;
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
+22 DO ADDERR("Was not able to delete secondary stop code visit (#"_PXAIEN_").")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;
+24 NEW PXAKILL
+25 IF "^"_PXAWHICH_"^"["^VISIT^"
Begin DoDot:1
+26 SET PXAKILL=$$KILL^VSITKIL(PXAVISIT)
+27 IF PXAKILL>0
Begin DoDot:2
+28 SET PXERRMSG="There are still "_PXAKILL_" entries pointing to this Visit. "
+29 SET PXERRMSG=PXERRMSG_"Therefore, the Visit could not be deleted."
+30 DO ADDERR(PXERRMSG)
End DoDot:2
End DoDot:1
+31 DO UNLOCK^PXLOCK(PXAVISIT,DUZ,"PXAPIDEL")
+32 QUIT $SELECT(PXARET=0!$DATA(PXKERROR):0,$GET(PXAKILL):-4,1:1)
+33 ;
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 ;If the hospital location is null there cannot be an appointment.
+7 IF SDCL=""
QUIT $GET(SCDXPOV)
+8 SET SDARRAY(1)=SDATE_";"_SDATE
SET SDFN=$PIECE(SVSTSTR,U,5)
+9 SET SDARRAY(4)=SDFN
+10 SET SDARRAY(2)=SDCL
+11 SET SDARRAY("FLDS")="2;12;16"
+12 NEW SDCOUNT
SET SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
+13 IF '$DATA(^TMP($JOB,"SDAMA301",SDFN,SDCL,SDATE))
QUIT $GET(SCDXPOV)
+14 SET SDAPP=^TMP($JOB,"SDAMA301",SDFN,SDCL,SDATE)
+15 ; OE
NEW SDENC
SET SDENC=$PIECE(SDAPP,U,12)
+16 ; get OE from VISIT
+17 NEW SDOEP
+18 KILL ^TMP($JOB,"SDAMA301")
+19 DO LISTVST^SDOERPC(.SDOEP,PXAVISIT)
+20 SET SDOEP=$PIECE(SDOEP,")")_","_""""""_")"
+21 SET SDOEP=$ORDER(@SDOEP)
+22 ; active appointment is associated with this visit
IF SDOEP>0
IF SDENC=SDOEP
SET SCDXPOV=1
QUIT SCDXPOV
+23 QUIT $GET(SCDXPOV)
+24 ;
ADDERR(PXMSG) ;
+1 SET PXERRCNT=PXERRCNT+1
+2 SET PXAPROB(PXERRCNT)=PXMSG
+3 QUIT
