- 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 Feb 18, 2025@23:52:01 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 ;
