PXAI ;ISL/JVS,PKR ISA/KWP,ESW - PCE DRIVING RTN FOR 'DATA2PCE' API ;01/26/2021
;;1.0;PCE PATIENT CARE ENCOUNTER;**15,74,69,102,111,112,130,164,168,215,211**;Aug 12, 1996;Build 454
Q
;
;+ 1 2 3 4 5 6 7 8 9
DATA2PCE(PXADATA,PXAPKG,PXASOURC,PXAVISIT,PXAUSER,PXANOT,ERRRET,PXAPREDT,PXAPROB,PXACCNT) ;+API to pass data for add/edit/delete to PCE.
;+ PXADATA (required)
;+ PXAPKG (required)
;+ PXASOURC (required)
;+ PXAVISIT (optional) is pointer to a visit for which the data is to
;+ be related. If the visit is not known then there must be
;+ the ENCOUNTER nodes needed to lookup/create the visit.
;+ PXAUSER (optional) this is a pointer to the user adding the data.
;+ PXANOT (optional) set to 1 if errors are to be displayed to the screen should only be set while writing and debugging the initial code.
;+ ERRRET (optional) passed by reference. If present will return PXKERROR
;+ array elements to the caller.
;+ PXAPREDT (optional) Set to 1 if you want to edit the Primary Provider
;+ only use if for the moment that editing is being done. (dangerous)
;+ 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.
;+ IF ERROR1 - (GENERAL ERRORS)
;+ PXAPROB($J,SUBSCRIPT,"ERROR1",PASSED IN 'FILE',PASSED IN FIELD,
;+ SUBSCRIPT FROM PXADATA)
;+ PXAPROB(23432234,2,"ERROR1","PROVIDER","NAME",7)="BECAUSE..."
;+ IF WARNING2 - (GENERAL WARNINGS)
;+ PXAPROB($J,SUBSCRIPT,"WARNING2",PASSED IN 'FILE',PASSED IN FIELD,
;+ SUBSCRIPT FROM PXADATA)
;+ PXAPROB(23432234,3,"WARNING2","PROCEDURE","QTY",3)="BECAUSE..."
;+ IF WARNING3 - (WARNINGS FOR SERVICE CONNECTION)
;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"AO")=REASON
;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"EC")=REASON
;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"IR")=REASON
;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"SC")=REASON
;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"MST")=REASON
;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"HNC")=REASON
;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"CV")=REASON
;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"SHAD")=REASON
;+ IF ERROR4 - (PROBLEM LIST ERRORS)
;+ PXAPROB($J,6,"ERROR4","PX/DL",(SUBSCRIPT FROM PXADATA))=REASON
;+ PXACCNT (optional) passed by reference. Returns the PFSS Account
; Reference if known. Returned as null if the PFSS Account
; Reference is located in the Order file(#100)
;+
;+
;+ Returns:
;+ 1 if no errors and process completely
;+ -1 if errors occurred but processed completely as possible
;+ -2 if could not get a visit
;+ -3 if called incorrectly
;+ -4 if cannot get a lock on the encounter
;+ -5 if there were only warnings
;
NEW ;--NEW VARIABLES
N NOVSIT,PXAK,DFN,PXAERRF,PXAERRW,PXADEC,PXELAP,PXASUB
N PATIENT,VALQUIET,PRIMFND
K PXAERROR,PXKERROR,PXAERR,PRVDR
S PXASUB=0,VALQUIET=1
;Lookup or create Visit if it is not passed.
I '$G(PXAVISIT),'$D(@PXADATA@("ENCOUNTER")) Q -3
I $G(PXAUSER)="" S PXAUSER=DUZ
K ^TMP("PXK",$J),^TMP("DIERR",$J),^TMP("PXAIADDPRV",$J)
;
VST ;--VISIT
I $G(PXAVISIT)'="" D VPTR^PXAIVSTV(PXAVISIT) I $G(PXAERRF) S PXAK=1 D ERR("VISIT",1) Q -2
D VST^PXAIVST
I $G(PXAVISIT)<0 Q -2
I $G(PXAERRF) M ERRRET=PXKERROR D ERR("VISIT",1) K PXAERR Q $S(PXAERRF=4:-4,1:-2)
;
SOURCE ;--Validate PACKAGE AND SOURCE.
N EPKG,ESOURCE
S EPKG=$P($G(^AUPNVSIT(PXAVISIT,812)),U,2)
S PXAPKG=$$VPKG^PXAIVSTV(EPKG,PXAPKG)
I $G(PXAERRF) S PXAK=1 D ERR("PACKAGE",1) Q -3
I $G(PXAERRW) S PXAK=1 D ERR("PACKAGE",1)
S ESOURCE=$P($G(^AUPNVSIT(PXAVISIT,812)),U,3)
S PXASOURC=$$VSOURCE^PXAIVSTV(PXAPKG,ESOURCE,PXASOURC)
I $G(PXAERRF) S PXAK=1 D ERR("SOURCE",1) Q -3
I $G(PXAERRW) S PXAK=1 D ERR("SOURCE",1)
D SPKGSRC^PXAIVST(PXAVISIT,EPKG,PXAPKG,ESOURCE,PXASOURC,.PXAERRF,.PXAERR)
I $G(PXAERRF) S PXAK=1 D ERR("PKG/SOURCE",1) Q -3
S ^TMP("PXK",$J,"SOR")=PXASOURC
;
USER ;--If a USER is passed validate it.
I $G(PXAUSER)'="" D VUSER^PXAIVSTV(PXAUSER) I $G(PXAERRF) D ERR("USER",1) Q -3
;
PRV ;--PROVIDER
I $D(@PXADATA@("PROVIDER")) D
.;Check for primary provider issues.
. D PRIM^PXAIPRVV(PXAVISIT,.PXADATA,.PXAERRF,$G(PXAPREDT))
. I $G(PXAERRF("PRV")) S PXAK=1 D ERR("PROVIDER",1) K PXAERR Q
. I $G(PXAERRW("PRV")) S PXAK=1 D ERR("PROVIDER",1) K PXAERR
. S PXAK=0 F S PXAK=$O(@PXADATA@("PROVIDER",PXAK)) Q:PXAK="" D
.. D PRV^PXAIPRV
.. I $G(PXAERRF("PRV")) D ERR("PROVIDER",PXAK) K PXAERR
;
POV ;--DIAGNOSIS
I $D(@PXADATA@("DX/PL")) D
.;Check for more than one primary diagnosis.
. D PRIM^PXAIPOVV(PXAVISIT,.PXADATA,.PXAERRF)
. I $G(PXAERRF("POV")) S PXAK=1 D ERR("DX/PL",1) K PXAERR Q
. I $G(PXAERRW("POV")) S PXAK=1 D ERR("DX/PL",1) K PXAERR
. D SPOVPRIM^PXAIPOV(PXADATA,PXAVISIT,.PXAERR)
. I $G(PXAERRF("POV")) S PXAK=1 D ERR("DX/PL",1) K PXAERR Q
. S PXAK=0 F S PXAK=$O(@PXADATA@("DX/PL",PXAK)) Q:PXAK="" D
.. D POV^PXAIPOV
.. I $G(PXAERRF("POV")) D ERR("DX/PL",PXAK) K PXAERR
;
CPT ;--PROCEDURE
S PXAK=0 F S PXAK=$O(@PXADATA@("PROCEDURE",PXAK)) Q:PXAK="" D
. D CPT^PXAICPT I $G(PXAERRF("CPT"))!$G(PXAERRW("CPT")) D ERR("PROCEDURE",PXAK)
K PXAERR
;
EDU ;--PATIENT EDUCATION
S PXAK=0 F S PXAK=$O(@PXADATA@("PATIENT ED",PXAK)) Q:PXAK="" D
. D EDU^PXAIPED I $G(PXAERRF("PED"))!$G(PXAERRW("PED")) D ERR("PATIENT ED",PXAK)
K PXAERR
;
EXAM ;--EXAMINATION
S PXAK=0 F S PXAK=$O(@PXADATA@("EXAM",PXAK)) Q:PXAK="" D
. D EXAM^PXAIXAM I $G(PXAERRF("XAM"))!$G(PXAERRW("XAM")) D ERR("EXAM",PXAK)
K PXAERR
;
HF ;--HEALTH FACTOR
S PXAK=0 F S PXAK=$O(@PXADATA@("HEALTH FACTOR",PXAK)) Q:PXAK="" D
. D HF^PXAIHF I $G(PXAERRF("HF"))!$G(PXAERRW("HF")) D ERR("HEALTH FACTOR",PXAK)
K PXAERR
;
IMM ;--IMMUNIZATION
S PXAK=0 F S PXAK=$O(@PXADATA@("IMMUNIZATION",PXAK)) Q:PXAK="" D
. D IMM^PXAIIMM I $G(PXAERRF("IMM"))!$G(PXAIERRW("IMM")) D ERR("IMMUNIZATION",PXAK)
K PXAERR
;
SKIN ;--SKIN TEST
S PXAK=0 F S PXAK=$O(@PXADATA@("SKIN TEST",PXAK)) Q:PXAK="" D
. D SKIN^PXAISK I $G(PXAERRF("SK"))!$G(PXAERRW("SK")) D ERR("SKIN TEST",PXAK)
K PXAERR
;
ICR ;--IMM CONTRAINDICATION/REFUSAL
S PXAK=0 F S PXAK=$O(@PXADATA@("IMM CONTRA/REFUSAL",PXAK)) Q:PXAK="" D
. D ICR^PXAIICR I $G(PXAERRF("ICR"))!$G(PXAERRW("ICR")) D ERR("IMM CONTRA/REFUSAL",PXAK)
K PXAERR
;
SC ;--STANDARD CODES
S PXAK=0 F S PXAK=$O(@PXADATA@("STD CODES",PXAK)) Q:PXAK="" D
. D SC^PXAISC I $G(PXAERRF("SC"))!$G(PXAERRW("SC")) D ERR("STD CODES",PXAK)
K PXAERR
;
D OTHER^PXAIPRV
;
I $D(^TMP("PXK",$J)) D
. D EN1^PXKMAIN
.;If necessary set a default primary provider.
. D PRIM^PXAIPRV
. D EVENT^PXKMAIN
;
;If errors have been recorded in PXKERROR pass them back.
I $D(PXKERROR) M ERRRET=PXKERROR S PXAERRF=1
;
S PXACCNT=$P($G(^AUPNVSIT(PXAVISIT,0)),"^",26) ;PX*1.0*164 ;Sets the PFSS Account Reference, if any
K ^TMP("PXAIADDPRV",$J),^TMP("PXK",$J),PXAERR,PXKERROR
Q $S($D(PXAERRF):-1,$D(PXAERRW):-5,1:1)
;
EXIT ;--EXIT AND CLEAN UP
D EVENT^PXKMAIN
K ^TMP("PXK",$J),PRVDR
K PXAERR
Q
;
;-----------------SUBROUTINES-----------------------
ERR(DATATYPE,NUM) ;
I '$D(PXADI("DIALOG")) Q
N NODE,SCREEN
S PXAERR(1)=$G(PXADATA),PXAERR(2)=$G(PXAPKG),PXAERR(3)=$G(PXASOURC)
S PXAERR(4)=$G(PXAVISIT),PXAERR(5)=$G(PXAUSER)_" "_$P($G(^VA(200,PXAUSER,0)),"^",1)
D SSCL^PXAIERR(.PXAERR)
I $G(PXANOT)=1 D EXTERNAL
E D INTERNAL(DATATYPE,NUM)
D SETPROB^PXAIERR
K PXADI("DIALOG")
Q
;
EXTERNAL ;---SEND ERRORS TO SCREEN
W !,"-----------------------------------------------------------------"
D BLD^DIALOG($G(PXADI("DIALOG")),.PXAERR,"","SCREEN","F")
D MSG^DIALOG("ESW","",(IOM-2),2,"SCREEN")
Q
;
INTERNAL(DATATYPE,NUM) ;---SET ERRORS TO GLOBAL ARRAY
N OUTPUT,TEMP
D BLD^DIALOG($G(PXADI("DIALOG")),.PXAERR,"","TEMP","F")
D MSG^DIALOG("AES",.OUTPUT,80,"","TEMP")
M ERRRET(DATATYPE,NUM)=OUTPUT
M @PXADATA=TEMP
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAI 8215 printed Apr 09, 2024@21:30:27 Page 2
PXAI ;ISL/JVS,PKR ISA/KWP,ESW - PCE DRIVING RTN FOR 'DATA2PCE' API ;01/26/2021
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**15,74,69,102,111,112,130,164,168,215,211**;Aug 12, 1996;Build 454
+2 QUIT
+3 ;
+4 ;+ 1 2 3 4 5 6 7 8 9
DATA2PCE(PXADATA,PXAPKG,PXASOURC,PXAVISIT,PXAUSER,PXANOT,ERRRET,PXAPREDT,PXAPROB,PXACCNT) ;+API to pass data for add/edit/delete to PCE.
+1 ;+ PXADATA (required)
+2 ;+ PXAPKG (required)
+3 ;+ PXASOURC (required)
+4 ;+ PXAVISIT (optional) is pointer to a visit for which the data is to
+5 ;+ be related. If the visit is not known then there must be
+6 ;+ the ENCOUNTER nodes needed to lookup/create the visit.
+7 ;+ PXAUSER (optional) this is a pointer to the user adding the data.
+8 ;+ PXANOT (optional) set to 1 if errors are to be displayed to the screen should only be set while writing and debugging the initial code.
+9 ;+ ERRRET (optional) passed by reference. If present will return PXKERROR
+10 ;+ array elements to the caller.
+11 ;+ PXAPREDT (optional) Set to 1 if you want to edit the Primary Provider
+12 ;+ only use if for the moment that editing is being done. (dangerous)
+13 ;+ PXAPROB (optional) A dotted variable name. When errors and
+14 ;+ warnings occur, They will be passed back in the form
+15 ;+ of an array with the general description of the problem.
+16 ;+ IF ERROR1 - (GENERAL ERRORS)
+17 ;+ PXAPROB($J,SUBSCRIPT,"ERROR1",PASSED IN 'FILE',PASSED IN FIELD,
+18 ;+ SUBSCRIPT FROM PXADATA)
+19 ;+ PXAPROB(23432234,2,"ERROR1","PROVIDER","NAME",7)="BECAUSE..."
+20 ;+ IF WARNING2 - (GENERAL WARNINGS)
+21 ;+ PXAPROB($J,SUBSCRIPT,"WARNING2",PASSED IN 'FILE',PASSED IN FIELD,
+22 ;+ SUBSCRIPT FROM PXADATA)
+23 ;+ PXAPROB(23432234,3,"WARNING2","PROCEDURE","QTY",3)="BECAUSE..."
+24 ;+ IF WARNING3 - (WARNINGS FOR SERVICE CONNECTION)
+25 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"AO")=REASON
+26 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"EC")=REASON
+27 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"IR")=REASON
+28 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"SC")=REASON
+29 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"MST")=REASON
+30 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"HNC")=REASON
+31 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"CV")=REASON
+32 ;+ PXAPROB($J,1,"WARNING3","ENCOUNTER",1,"SHAD")=REASON
+33 ;+ IF ERROR4 - (PROBLEM LIST ERRORS)
+34 ;+ PXAPROB($J,6,"ERROR4","PX/DL",(SUBSCRIPT FROM PXADATA))=REASON
+35 ;+ PXACCNT (optional) passed by reference. Returns the PFSS Account
+36 ; Reference if known. Returned as null if the PFSS Account
+37 ; Reference is located in the Order file(#100)
+38 ;+
+39 ;+
+40 ;+ Returns:
+41 ;+ 1 if no errors and process completely
+42 ;+ -1 if errors occurred but processed completely as possible
+43 ;+ -2 if could not get a visit
+44 ;+ -3 if called incorrectly
+45 ;+ -4 if cannot get a lock on the encounter
+46 ;+ -5 if there were only warnings
+47 ;
NEW ;--NEW VARIABLES
+1 NEW NOVSIT,PXAK,DFN,PXAERRF,PXAERRW,PXADEC,PXELAP,PXASUB
+2 NEW PATIENT,VALQUIET,PRIMFND
+3 KILL PXAERROR,PXKERROR,PXAERR,PRVDR
+4 SET PXASUB=0
SET VALQUIET=1
+5 ;Lookup or create Visit if it is not passed.
+6 IF '$GET(PXAVISIT)
IF '$DATA(@PXADATA@("ENCOUNTER"))
QUIT -3
+7 IF $GET(PXAUSER)=""
SET PXAUSER=DUZ
+8 KILL ^TMP("PXK",$JOB),^TMP("DIERR",$JOB),^TMP("PXAIADDPRV",$JOB)
+9 ;
VST ;--VISIT
+1 IF $GET(PXAVISIT)'=""
DO VPTR^PXAIVSTV(PXAVISIT)
IF $GET(PXAERRF)
SET PXAK=1
DO ERR("VISIT",1)
QUIT -2
+2 DO VST^PXAIVST
+3 IF $GET(PXAVISIT)<0
QUIT -2
+4 IF $GET(PXAERRF)
MERGE ERRRET=PXKERROR
DO ERR("VISIT",1)
KILL PXAERR
QUIT $SELECT(PXAERRF=4:-4,1:-2)
+5 ;
SOURCE ;--Validate PACKAGE AND SOURCE.
+1 NEW EPKG,ESOURCE
+2 SET EPKG=$PIECE($GET(^AUPNVSIT(PXAVISIT,812)),U,2)
+3 SET PXAPKG=$$VPKG^PXAIVSTV(EPKG,PXAPKG)
+4 IF $GET(PXAERRF)
SET PXAK=1
DO ERR("PACKAGE",1)
QUIT -3
+5 IF $GET(PXAERRW)
SET PXAK=1
DO ERR("PACKAGE",1)
+6 SET ESOURCE=$PIECE($GET(^AUPNVSIT(PXAVISIT,812)),U,3)
+7 SET PXASOURC=$$VSOURCE^PXAIVSTV(PXAPKG,ESOURCE,PXASOURC)
+8 IF $GET(PXAERRF)
SET PXAK=1
DO ERR("SOURCE",1)
QUIT -3
+9 IF $GET(PXAERRW)
SET PXAK=1
DO ERR("SOURCE",1)
+10 DO SPKGSRC^PXAIVST(PXAVISIT,EPKG,PXAPKG,ESOURCE,PXASOURC,.PXAERRF,.PXAERR)
+11 IF $GET(PXAERRF)
SET PXAK=1
DO ERR("PKG/SOURCE",1)
QUIT -3
+12 SET ^TMP("PXK",$JOB,"SOR")=PXASOURC
+13 ;
USER ;--If a USER is passed validate it.
+1 IF $GET(PXAUSER)'=""
DO VUSER^PXAIVSTV(PXAUSER)
IF $GET(PXAERRF)
DO ERR("USER",1)
QUIT -3
+2 ;
PRV ;--PROVIDER
+1 IF $DATA(@PXADATA@("PROVIDER"))
Begin DoDot:1
+2 ;Check for primary provider issues.
+3 DO PRIM^PXAIPRVV(PXAVISIT,.PXADATA,.PXAERRF,$GET(PXAPREDT))
+4 IF $GET(PXAERRF("PRV"))
SET PXAK=1
DO ERR("PROVIDER",1)
KILL PXAERR
QUIT
+5 IF $GET(PXAERRW("PRV"))
SET PXAK=1
DO ERR("PROVIDER",1)
KILL PXAERR
+6 SET PXAK=0
FOR
SET PXAK=$ORDER(@PXADATA@("PROVIDER",PXAK))
if PXAK=""
QUIT
Begin DoDot:2
+7 DO PRV^PXAIPRV
+8 IF $GET(PXAERRF("PRV"))
DO ERR("PROVIDER",PXAK)
KILL PXAERR
End DoDot:2
End DoDot:1
+9 ;
POV ;--DIAGNOSIS
+1 IF $DATA(@PXADATA@("DX/PL"))
Begin DoDot:1
+2 ;Check for more than one primary diagnosis.
+3 DO PRIM^PXAIPOVV(PXAVISIT,.PXADATA,.PXAERRF)
+4 IF $GET(PXAERRF("POV"))
SET PXAK=1
DO ERR("DX/PL",1)
KILL PXAERR
QUIT
+5 IF $GET(PXAERRW("POV"))
SET PXAK=1
DO ERR("DX/PL",1)
KILL PXAERR
+6 DO SPOVPRIM^PXAIPOV(PXADATA,PXAVISIT,.PXAERR)
+7 IF $GET(PXAERRF("POV"))
SET PXAK=1
DO ERR("DX/PL",1)
KILL PXAERR
QUIT
+8 SET PXAK=0
FOR
SET PXAK=$ORDER(@PXADATA@("DX/PL",PXAK))
if PXAK=""
QUIT
Begin DoDot:2
+9 DO POV^PXAIPOV
+10 IF $GET(PXAERRF("POV"))
DO ERR("DX/PL",PXAK)
KILL PXAERR
End DoDot:2
End DoDot:1
+11 ;
CPT ;--PROCEDURE
+1 SET PXAK=0
FOR
SET PXAK=$ORDER(@PXADATA@("PROCEDURE",PXAK))
if PXAK=""
QUIT
Begin DoDot:1
+2 DO CPT^PXAICPT
IF $GET(PXAERRF("CPT"))!$GET(PXAERRW("CPT"))
DO ERR("PROCEDURE",PXAK)
End DoDot:1
+3 KILL PXAERR
+4 ;
EDU ;--PATIENT EDUCATION
+1 SET PXAK=0
FOR
SET PXAK=$ORDER(@PXADATA@("PATIENT ED",PXAK))
if PXAK=""
QUIT
Begin DoDot:1
+2 DO EDU^PXAIPED
IF $GET(PXAERRF("PED"))!$GET(PXAERRW("PED"))
DO ERR("PATIENT ED",PXAK)
End DoDot:1
+3 KILL PXAERR
+4 ;
EXAM ;--EXAMINATION
+1 SET PXAK=0
FOR
SET PXAK=$ORDER(@PXADATA@("EXAM",PXAK))
if PXAK=""
QUIT
Begin DoDot:1
+2 DO EXAM^PXAIXAM
IF $GET(PXAERRF("XAM"))!$GET(PXAERRW("XAM"))
DO ERR("EXAM",PXAK)
End DoDot:1
+3 KILL PXAERR
+4 ;
HF ;--HEALTH FACTOR
+1 SET PXAK=0
FOR
SET PXAK=$ORDER(@PXADATA@("HEALTH FACTOR",PXAK))
if PXAK=""
QUIT
Begin DoDot:1
+2 DO HF^PXAIHF
IF $GET(PXAERRF("HF"))!$GET(PXAERRW("HF"))
DO ERR("HEALTH FACTOR",PXAK)
End DoDot:1
+3 KILL PXAERR
+4 ;
IMM ;--IMMUNIZATION
+1 SET PXAK=0
FOR
SET PXAK=$ORDER(@PXADATA@("IMMUNIZATION",PXAK))
if PXAK=""
QUIT
Begin DoDot:1
+2 DO IMM^PXAIIMM
IF $GET(PXAERRF("IMM"))!$GET(PXAIERRW("IMM"))
DO ERR("IMMUNIZATION",PXAK)
End DoDot:1
+3 KILL PXAERR
+4 ;
SKIN ;--SKIN TEST
+1 SET PXAK=0
FOR
SET PXAK=$ORDER(@PXADATA@("SKIN TEST",PXAK))
if PXAK=""
QUIT
Begin DoDot:1
+2 DO SKIN^PXAISK
IF $GET(PXAERRF("SK"))!$GET(PXAERRW("SK"))
DO ERR("SKIN TEST",PXAK)
End DoDot:1
+3 KILL PXAERR
+4 ;
ICR ;--IMM CONTRAINDICATION/REFUSAL
+1 SET PXAK=0
FOR
SET PXAK=$ORDER(@PXADATA@("IMM CONTRA/REFUSAL",PXAK))
if PXAK=""
QUIT
Begin DoDot:1
+2 DO ICR^PXAIICR
IF $GET(PXAERRF("ICR"))!$GET(PXAERRW("ICR"))
DO ERR("IMM CONTRA/REFUSAL",PXAK)
End DoDot:1
+3 KILL PXAERR
+4 ;
SC ;--STANDARD CODES
+1 SET PXAK=0
FOR
SET PXAK=$ORDER(@PXADATA@("STD CODES",PXAK))
if PXAK=""
QUIT
Begin DoDot:1
+2 DO SC^PXAISC
IF $GET(PXAERRF("SC"))!$GET(PXAERRW("SC"))
DO ERR("STD CODES",PXAK)
End DoDot:1
+3 KILL PXAERR
+4 ;
+5 DO OTHER^PXAIPRV
+6 ;
+7 IF $DATA(^TMP("PXK",$JOB))
Begin DoDot:1
+8 DO EN1^PXKMAIN
+9 ;If necessary set a default primary provider.
+10 DO PRIM^PXAIPRV
+11 DO EVENT^PXKMAIN
End DoDot:1
+12 ;
+13 ;If errors have been recorded in PXKERROR pass them back.
+14 IF $DATA(PXKERROR)
MERGE ERRRET=PXKERROR
SET PXAERRF=1
+15 ;
+16 ;PX*1.0*164 ;Sets the PFSS Account Reference, if any
SET PXACCNT=$PIECE($GET(^AUPNVSIT(PXAVISIT,0)),"^",26)
+17 KILL ^TMP("PXAIADDPRV",$JOB),^TMP("PXK",$JOB),PXAERR,PXKERROR
+18 QUIT $SELECT($DATA(PXAERRF):-1,$DATA(PXAERRW):-5,1:1)
+19 ;
EXIT ;--EXIT AND CLEAN UP
+1 DO EVENT^PXKMAIN
+2 KILL ^TMP("PXK",$JOB),PRVDR
+3 KILL PXAERR
+4 QUIT
+5 ;
+6 ;-----------------SUBROUTINES-----------------------
ERR(DATATYPE,NUM) ;
+1 IF '$DATA(PXADI("DIALOG"))
QUIT
+2 NEW NODE,SCREEN
+3 SET PXAERR(1)=$GET(PXADATA)
SET PXAERR(2)=$GET(PXAPKG)
SET PXAERR(3)=$GET(PXASOURC)
+4 SET PXAERR(4)=$GET(PXAVISIT)
SET PXAERR(5)=$GET(PXAUSER)_" "_$PIECE($GET(^VA(200,PXAUSER,0)),"^",1)
+5 DO SSCL^PXAIERR(.PXAERR)
+6 IF $GET(PXANOT)=1
DO EXTERNAL
+7 IF '$TEST
DO INTERNAL(DATATYPE,NUM)
+8 DO SETPROB^PXAIERR
+9 KILL PXADI("DIALOG")
+10 QUIT
+11 ;
EXTERNAL ;---SEND ERRORS TO SCREEN
+1 WRITE !,"-----------------------------------------------------------------"
+2 DO BLD^DIALOG($GET(PXADI("DIALOG")),.PXAERR,"","SCREEN","F")
+3 DO MSG^DIALOG("ESW","",(IOM-2),2,"SCREEN")
+4 QUIT
+5 ;
INTERNAL(DATATYPE,NUM) ;---SET ERRORS TO GLOBAL ARRAY
+1 NEW OUTPUT,TEMP
+2 DO BLD^DIALOG($GET(PXADI("DIALOG")),.PXAERR,"","TEMP","F")
+3 DO MSG^DIALOG("AES",.OUTPUT,80,"","TEMP")
+4 MERGE ERRRET(DATATYPE,NUM)=OUTPUT
+5 MERGE @PXADATA=TEMP
+6 QUIT
+7 ;
