PXAPIDEL ;ISL/dee - PCE's code for the DELVFILE api ;11/14/2018
;;1.0;PCE PATIENT CARE ENCOUNTER;**1,9,22,130,168,197,216,211**;Aug 12, 1996;Build 454
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 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
;
;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 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_"~") 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
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")
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
;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:"")
.... 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
. 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^" S PXAKILL=$$KILL^VSITKIL(PXAVISIT)
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)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAPIDEL 8898 printed Aug 11, 2022@22:26:19 Page 2
PXAPIDEL ;ISL/dee - PCE's code for the DELVFILE api ;11/14/2018
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,9,22,130,168,197,216,211**;Aug 12, 1996;Build 454
+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 deleted.
+30 ; -2 if could not get a visit
+31 ; -3 if called incorrectly
+32 ; -4 if dependent entry count is still greater than zero
+33 ; -5 if encounter cannot be locked
+34 ;
+35 ;Good visit?
+36 if '$GET(PXAVISIT)
QUIT -2
+37 if '($DATA(^AUPNVSIT(PXAVISIT,0))#2)
QUIT -2
+38 ;
+39 ;Get package pointer
+40 SET PACKAGE=$GET(PACKAGE)
+41 IF PACKAGE=""
SET PXAPKG=0
+42 IF '$TEST
IF PACKAGE=+PACKAGE
SET PXAPKG=PACKAGE
+43 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
+44 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
+45 ;
+46 ;Lookup source in PCE DATA SOURCE file (#839.7) with LAYGO
+47 SET SOURCE=$GET(SOURCE)
+48 IF SOURCE=""
SET PXASOURC=0
+49 IF '$TEST
IF SOURCE=+SOURCE
SET PXASOURC=SOURCE
+50 IF '$TEST
SET PXASOURC=$$SOURCE^PXAPIUTL(SOURCE)
+51 IF +PXASOURC=-1
if '$DATA(ZTQUEUED)
WRITE !,"Procedure ""DELVFILE^PXAPI"" was called incorrectly without a valid ""SOURCE"", contact IRM."
QUIT -3
+52 ;
+53 KILL ^TMP("PXK",$JOB)
+54 NEW INDEX,PXACOUNT,PXAINDX,PXAVFILE,PXAFILE,PXARET,PXAWFLAG
+55 NEW PXALEN,PXAIEN,PXAPIECE,PXAMYSOR
+56 SET PXARET=1
+57 ; PX*1*216
IF PXAWHICH="ALL"
SET PXAWHICH="VISIT^STOP^CPT^IMM^PED^POV^PRV^SK^TRT^HF^XAM^ICR^SC"
+58 SET PXALEN=$LENGTH(PXAWHICH,"^")
+59 if PXALEN<1
QUIT -3
+60 IF '$TEST
FOR PXACOUNT=1:1:PXALEN
SET PXAVFILE=$PIECE(PXAWHICH,"^",PXACOUNT)
Begin DoDot:1
+61 ; PX*1*216
IF "~VISIT~STOP~CPT~IMM~PED~POV~PRV~SK~TRT~HF~XAM~ICR~SC~"'[("~"_PXAVFILE_"~")
SET PXARET=-3
End DoDot:1
if PXARET<0
QUIT
+62 if PXARET<0
QUIT PXARET
+63 IF PXAASK
Begin DoDot:1
+64 NEW DIR,X,Y
+65 ;ask the user if they want to delete
+66 SET DIR(0)="Y"
+67 SET DIR("A")="Are you sure you want to delete the encounter information"
+68 SET DIR("B")="NO"
+69 DO ^DIR
+70 IF Y'=1
SET PXARET=-1
QUIT
End DoDot:1
if PXARET<0
QUIT PXARET
+71 IF PXARET-1
QUIT -1
+72 SET PXAWFLAG=PXAECHO&'$DATA(ZTQUEUED)
+73 ;Lock the encounter before doing any deletions.
+74 NEW ERROR,LOCK
+75 SET LOCK=$$LOCK^PXLOCK(PXAVISIT,DUZ,2,.ERROR,"PXAPIDEL")
+76 IF LOCK=0
Begin DoDot:1
+77 IF PXAWFLAG
WRITE !,ERROR("LOCK")
End DoDot:1
QUIT -5
+78 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
End DoDot:3
End DoDot:2
End DoDot:1
+10 ;Set up the visit
+11 SET ^TMP("PXK",$JOB,"PKG")=PXAPKG
+12 SET ^TMP("PXK",$JOB,"SOR")=PXAMYSOR
+13 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXAVISIT
+14 FOR PXAPIECE=0,21,150,800,811
Begin DoDot:1
+15 SET (^TMP("PXK",$JOB,"VST",1,PXAPIECE,"BEFORE"),^TMP("PXK",$JOB,"VST",1,PXAPIECE,"AFTER"))=$GET(^AUPNVSIT(PXAVISIT,PXAPIECE))
End DoDot:1
+16 ;
+17 FOR PXACOUNT=1:1:PXALEN
SET PXAVFILE=$PIECE(PXAWHICH,"^",PXACOUNT)
Begin DoDot:1
+18 IF PXAVFILE="VISIT"
Begin DoDot:2
+19 ;set fields to @
+20 SET $PIECE(^TMP("PXK",$JOB,"VST",1,0,"AFTER"),"^",18)="@"
+21 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
+22 ;skip already done
IF '$TEST
IF PXAVFILE="STOP"
+23 ;the v-files
IF '$TEST
Begin DoDot:2
+24 SET PXAWFLAG=PXAECHO&'$DATA(ZTQUEUED)
+25 SET PXAFILE=$PIECE($TEXT(FORMAT^@("PXCE"_$SELECT(PXAVFILE="IMM":"VIMM",1:PXAVFILE))),"~",5)
+26 SET PXAIEN=0
+27 FOR PXAINDX=1:1
SET PXAIEN=$ORDER(@(PXAFILE_"(""AD"",PXAVISIT,PXAIEN)"))
if 'PXAIEN
QUIT
Begin DoDot:3
+28 IF $PIECE($GET(@(PXAFILE_"(PXAIEN,812)")),"^",1)
SET PXARET=0
QUIT
+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 SET ^TMP("PXK",$JOB,PXAVFILE,PXAINDX,0,"BEFORE")=@(PXAFILE_"(PXAIEN,0)")
+33 SET ^TMP("PXK",$JOB,PXAVFILE,PXAINDX,0,"AFTER")="@"
+34 SET ^TMP("PXK",$JOB,PXAVFILE,PXAINDX,"IEN")=PXAIEN
+35 IF PXAWFLAG
Begin DoDot:4
+36 SET PXAWFLAG=0
+37 WRITE !," ...deleting "
+38 ; PX*1*216
WRITE $SELECT("CPT"=PXAVFILE:"Procedure","IMM"=PXAVFILE:"Immunizations","PED"=PXAVFILE:"Patient Education","ICR"=PXAVFILE:"Contra/Refusal Event",1:"")
+39 WRITE $SELECT("POV"=PXAVFILE:"Diagnoses","PRV"=PXAVFILE:"Providers","SK"=PXAVFILE:"Skin Test","TRT"=PXAVFILE:"Treatments","HF"=PXAVFILE:"Health Factors","XAM"=PXAVFILE:"Exams",1:"")
+40 WRITE $SELECT("SC"=PXAVFILE:"Standard Codes",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 NEW PXKERROR
+44 IF $DATA(^TMP("PXK",$JOB))
Begin DoDot:1
+45 IF PXAECHO
IF '$DATA(ZTQUEUED)
DO WAIT^DICD
+46 DO EN1^PXKMAIN
+47 DO EVENT^PXKMAIN
+48 KILL ^TMP("PXK",$JOB)
End DoDot:1
+49 ;
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^"
SET PXAKILL=$$KILL^VSITKIL(PXAVISIT)
+25 DO UNLOCK^PXLOCK(PXAVISIT,DUZ,"PXAPIDEL")
+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 ;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 ;
