- PXAI ;ISL/JVS,ISA/KWP,ESW - PCE DRIVING RTN FOR 'DATA2PCE' API ; 6/20/03 11:15am
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**15,74,69,102,111,112**;Aug 12, 1996
- Q
- ;
- ;+ 1 2 3 4 5 6 7 8 9
- DATA2PCE(PXADATA,PXAPKG,PXASOURC,PXAVISIT,PXAUSER,PXANOT,ERRRET,PXAPREDT,PXAPROB) ;+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 know 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 Provder
- ;+ only use if for the moment that editing is being done. (dangeous)
- ;+ .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
- ;+ IF ERROR4 - (PROBLEM LIST ERRORS)
- ;+ PXAPROB($J,6,"ERROR4","PX/DL",(SUBSCRIPT FROM PXADATA))=REASON
- ;+
- ;+
- ;+
- ;+ 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
- ;
- NEW ;--NEW VARIABLES
- N NOVSIT,PXAK,DFN,PXAERRF,PXADEC,PXELAP,PXASUB
- N PATIENT,VALQUIET,PRIMFND
- K PXAERROR,PXKERROR,PXAERR,PRVDR
- S PXASUB=0,VALQUIET=1
- ; needs to look up if not passed.
- I '$G(PXAVISIT),'$D(@PXADATA@("ENCOUNTER")) Q -3
- I $G(PXAUSER)<1 S PXAUSER=DUZ
- ;
- K ^TMP("PXK",$J),^TMP("DIERR",$J),^TMP("PXAIADDPRV",$J)
- SOR ;--SOURCE
- I PXAPKG=+PXAPKG S PXAPKG=PXAPKG
- E S PXAPKG=$$PKG2IEN^VSIT(PXAPKG)
- I PXASOURC=+PXASOURC S PXASOURC=PXASOURC
- E S PXASOURC=$$SOURCE^PXAPIUTL(PXASOURC)
- ;
- D TMPSOURC^PXAPIUTL(PXASOURC) ;-SAVES & CREATES ^TMP("PXK",$J,"SOR")
- VST ;--VISIT
- ;--KILL VISIT
- I $G(PXAVISIT) D VPTR^PXAIVSTV I $G(PXAERRF) D ERR Q -2
- D VST^PXAIVST
- I $G(PXAVISIT)<0 Q -2
- I $G(PXAERRF) D ERR K PXAERR Q -2
- PRV ;--PROVIDER
- S PATIENT=$P($G(^AUPNVSIT(PXAVISIT,0)),"^",5)
- S (PXAK,PRIMFND)=0
- F S PXAK=$O(@PXADATA@("PROVIDER",PXAK)) Q:(PRIMFND)!(PXAK="") D
- .I $D(@PXADATA@("PROVIDER",PXAK,"PRIMARY")) D
- ..S PRIMFND=$G(@PXADATA@("PROVIDER",PXAK,"PRIMARY"))
- I 'PRIMFND D ;Check for each provider's status as Primary or Secondary
- .S PXAK=0 F S PXAK=$O(@PXADATA@("PROVIDER",PXAK)) Q:PXAK="" D
- ..I '$D(@PXADATA@("PROVIDER",PXAK,"PRIMARY")) D PROVDRST
- S PXAK=0 F S PXAK=$O(@PXADATA@("PROVIDER",PXAK)) Q:PXAK="" D
- . D PRV^PXAIPRV I $G(PXAERRF) D ERR
- K PRI ;--FLAG FOR PRIMARY PROVIDER
- K PXAERR
- CPT ;--PROCEDURE
- S PXAK=0 F S PXAK=$O(@PXADATA@("PROCEDURE",PXAK)) Q:PXAK="" D
- . D CPT^PXAICPT I $G(PXAERRF) D ERR
- K PXAERR
- ;
- POV ;--DIAGNOSIS
- S (PXAK,PRIMFND)=0
- F S PXAK=$O(@PXADATA@("DX/PL",PXAK)) Q:(PXAK="") D Q:PRIMFND
- .I +$G(@PXADATA@("DX/PL",PXAK,"PRIMARY"))=1 D
- ..S PRIMFND=$G(@PXADATA@("DX/PL",PXAK,"DIAGNOSIS"))
- I $D(@PXADATA@("DX/PL")) D POVPRM(PXAVISIT,PRIMFND,.PXADATA) D
- .S PXAK=0 F S PXAK=$O(@PXADATA@("DX/PL",PXAK)) Q:PXAK="" D
- ..D POV^PXAIPOV I $G(PXAERRF) D ERR
- 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) D ERR
- K PXAERR
- ;
- EXAM ;--EXAMINATION
- S PXAK=0 F S PXAK=$O(@PXADATA@("EXAM",PXAK)) Q:PXAK="" D
- . D EXAM^PXAIXAM I $G(PXAERRF) D ERR
- 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) D ERR
- K PXAERR
- ;
- IMM ;--IMMUNIZATION
- S PXAK=0 F S PXAK=$O(@PXADATA@("IMMUNIZATION",PXAK)) Q:PXAK="" D
- . D IMM^PXAIIMM I $G(PXAERRF) D ERR
- 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) D ERR
- K PXAERR
- ;
- ;
- D OTHER^PXAIPRV
- ;
- ;
- I $D(^TMP("PXK",$J)) D
- . D EN1^PXKMAIN
- . M ERRRET=PXKERROR
- . D PRIM^PXAIPRV K PRVDR
- . D EVENT^PXKMAIN
- K ^TMP("PXK",$J),PXAERR,PXKERROR
- Q $S($G(PXAERRF):-1,1:1)
- ;
- ;
- EXIT ;--EXIT AND CLEAN UP
- D EVENT^PXKMAIN
- K ^TMP("PXK",$J),PRVDR
- K PXAERR
- Q
- ;-----------------SUBROUTINES-----------------------
- ERR ;
- ;
- ;
- 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)
- I $G(PXANOT)=1 D EXTERNAL
- E D INTERNAL
- D ARRAY^PXAICPTV
- K PXADI("DIALOG")
- Q
- ;
- EXTERNAL ;---SEND ERRORS TO SCREEN
- W !,"-----------------------------------------------------------------"
- D BLD^DIALOG($G(PXADI("DIALOG")),.PXAERR,"","SCREEN","F")
- D MSG^DIALOG("ESW","",50,10,"SCREEN")
- ;
- Q
- INTERNAL ;---SET ERRORS TO GLOBAL ARRAY
- S NODE=PXADATA
- D BLD^DIALOG($G(PXADI("DIALOG")),.PXAERR,.PXAERR,NODE,"F")
- S NODE=$NA(@PXADATA@("DIERR",$J)) D MSG^DIALOG("ESW","",50,10,NODE)
- Q
- ;
- PROVDRST ; Check provider status (Primary or Secondary)
- N PRVIEN,DETS,DIC,DR,DA,DIQ,PRI,PRVPRIM
- I $G(PXAK)="" QUIT
- S PRVIEN=0
- F S PRVIEN=$O(^AUPNVPRV("AD",PXAVISIT,PRVIEN)) Q:PRVIEN="" D
- .S DETS=$G(^AUPNVPRV(PRVIEN,0))
- .I $P(DETS,U)=$G(@PXADATA@("PROVIDER",PXAK,"NAME")) D
- ..S DIC=9000010.06,DR=.04,DA=PRVIEN
- ..S DIQ="PRVPRIM(",DIQ(0)="EI" D EN^DIQ1
- ..S PRI=$E($G(PRVPRIM(9000010.06,DA,DR,"E")),1,1)
- ..S @PXADATA@("PROVIDER",PXAK,"PRIMARY")=$S(PRI="P":1,1:0)
- Q
- POVPRM(VISIT,PRIMFND,POVARR) ;
- N PRVIEN,DETS,STOP,LPXAK,ORDX,NDX,ORDXP
- S PRVIEN=0
- ;create array of existing DX; ORDX - pointer to ^ICD9(
- F S PRVIEN=$O(^AUPNVPOV("AD",PXAVISIT,PRVIEN)) Q:PRVIEN="" D
- .S DETS=$G(^AUPNVPOV(PRVIEN,0)),ORDX=$P(DETS,U)
- .S ORDX(ORDX)=PRVIEN I $P(DETS,U,12)="P" S ORDXP(ORDX)=""
- ; create array of passed DX; NDX - pointer to ^ICD9(
- S PXAK=0 F S PXAK=$O(@POVARR@("DX/PL",PXAK)) Q:PXAK="" D
- .S NDX=$G(@POVARR@("DX/PL",PXAK,"DIAGNOSIS")) S NDX(NDX)=PXAK
- ; force entry of originally primary diagnosis with "S" flag
- I PRIMFND S ORDX="" D
- .F S ORDX=$O(ORDXP(ORDX)) Q:ORDX="" I PRIMFND'=ORDX D
- ..I $D(NDX(ORDX)) S @POVARR@("DX/PL",NDX(ORDX),"PRIMARY")=0
- ..E D
- ...S LPXAK=$O(@POVARR@("DX/PL",""),-1)
- ...S @POVARR@("DX/PL",LPXAK+1,"DIAGNOSIS")=ORDX
- ...S @POVARR@("DX/PL",LPXAK+1,"PRIMARY")=0
- Q
- ;
- PXAI ;ISL/JVS,ISA/KWP,ESW - PCE DRIVING RTN FOR 'DATA2PCE' API ; 6/20/03 11:15am
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**15,74,69,102,111,112**;Aug 12, 1996
- +2 QUIT
- +3 ;
- +4 ;+ 1 2 3 4 5 6 7 8 9
- DATA2PCE(PXADATA,PXAPKG,PXASOURC,PXAVISIT,PXAUSER,PXANOT,ERRRET,PXAPREDT,PXAPROB) ;+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 know 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 Provder
- +12 ;+ only use if for the moment that editing is being done. (dangeous)
- +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 ;+ IF ERROR4 - (PROBLEM LIST ERRORS)
- +32 ;+ PXAPROB($J,6,"ERROR4","PX/DL",(SUBSCRIPT FROM PXADATA))=REASON
- +33 ;+
- +34 ;+
- +35 ;+
- +36 ;+ Returns:
- +37 ;+ 1 if no errors and process completely
- +38 ;+ -1 if errors occurred but processed completely as possible
- +39 ;+ -2 if could not get a visit
- +40 ;+ -3 if called incorrectly
- +41 ;
- NEW ;--NEW VARIABLES
- +1 NEW NOVSIT,PXAK,DFN,PXAERRF,PXADEC,PXELAP,PXASUB
- +2 NEW PATIENT,VALQUIET,PRIMFND
- +3 KILL PXAERROR,PXKERROR,PXAERR,PRVDR
- +4 SET PXASUB=0
- SET VALQUIET=1
- +5 ; needs to look up if not passed.
- +6 IF '$GET(PXAVISIT)
- IF '$DATA(@PXADATA@("ENCOUNTER"))
- QUIT -3
- +7 IF $GET(PXAUSER)<1
- SET PXAUSER=DUZ
- +8 ;
- +9 KILL ^TMP("PXK",$JOB),^TMP("DIERR",$JOB),^TMP("PXAIADDPRV",$JOB)
- SOR ;--SOURCE
- +1 IF PXAPKG=+PXAPKG
- SET PXAPKG=PXAPKG
- +2 IF '$TEST
- SET PXAPKG=$$PKG2IEN^VSIT(PXAPKG)
- +3 IF PXASOURC=+PXASOURC
- SET PXASOURC=PXASOURC
- +4 IF '$TEST
- SET PXASOURC=$$SOURCE^PXAPIUTL(PXASOURC)
- +5 ;
- +6 ;-SAVES & CREATES ^TMP("PXK",$J,"SOR")
- DO TMPSOURC^PXAPIUTL(PXASOURC)
- VST ;--VISIT
- +1 ;--KILL VISIT
- +2 IF $GET(PXAVISIT)
- DO VPTR^PXAIVSTV
- IF $GET(PXAERRF)
- DO ERR
- QUIT -2
- +3 DO VST^PXAIVST
- +4 IF $GET(PXAVISIT)<0
- QUIT -2
- +5 IF $GET(PXAERRF)
- DO ERR
- KILL PXAERR
- QUIT -2
- PRV ;--PROVIDER
- +1 SET PATIENT=$PIECE($GET(^AUPNVSIT(PXAVISIT,0)),"^",5)
- +2 SET (PXAK,PRIMFND)=0
- +3 FOR
- SET PXAK=$ORDER(@PXADATA@("PROVIDER",PXAK))
- IF (PRIMFND)!(PXAK="")
- QUIT
- Begin DoDot:1
- +4 IF $DATA(@PXADATA@("PROVIDER",PXAK,"PRIMARY"))
- Begin DoDot:2
- +5 SET PRIMFND=$GET(@PXADATA@("PROVIDER",PXAK,"PRIMARY"))
- End DoDot:2
- End DoDot:1
- +6 ;Check for each provider's status as Primary or Secondary
- IF 'PRIMFND
- Begin DoDot:1
- +7 SET PXAK=0
- FOR
- SET PXAK=$ORDER(@PXADATA@("PROVIDER",PXAK))
- IF PXAK=""
- QUIT
- Begin DoDot:2
- +8 IF '$DATA(@PXADATA@("PROVIDER",PXAK,"PRIMARY"))
- DO PROVDRST
- End DoDot:2
- End DoDot:1
- +9 SET PXAK=0
- FOR
- SET PXAK=$ORDER(@PXADATA@("PROVIDER",PXAK))
- IF PXAK=""
- QUIT
- Begin DoDot:1
- +10 DO PRV^PXAIPRV
- IF $GET(PXAERRF)
- DO ERR
- End DoDot:1
- +11 ;--FLAG FOR PRIMARY PROVIDER
- KILL PRI
- +12 KILL PXAERR
- 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)
- DO ERR
- End DoDot:1
- +3 KILL PXAERR
- +4 ;
- POV ;--DIAGNOSIS
- +1 SET (PXAK,PRIMFND)=0
- +2 FOR
- SET PXAK=$ORDER(@PXADATA@("DX/PL",PXAK))
- IF (PXAK="")
- QUIT
- Begin DoDot:1
- +3 IF +$GET(@PXADATA@("DX/PL",PXAK,"PRIMARY"))=1
- Begin DoDot:2
- +4 SET PRIMFND=$GET(@PXADATA@("DX/PL",PXAK,"DIAGNOSIS"))
- End DoDot:2
- End DoDot:1
- IF PRIMFND
- QUIT
- +5 IF $DATA(@PXADATA@("DX/PL"))
- DO POVPRM(PXAVISIT,PRIMFND,.PXADATA)
- Begin DoDot:1
- +6 SET PXAK=0
- FOR
- SET PXAK=$ORDER(@PXADATA@("DX/PL",PXAK))
- IF PXAK=""
- QUIT
- Begin DoDot:2
- +7 DO POV^PXAIPOV
- IF $GET(PXAERRF)
- DO ERR
- End DoDot:2
- End DoDot:1
- +8 KILL PXAERR
- +9 ;
- 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)
- DO ERR
- 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)
- DO ERR
- 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)
- DO ERR
- 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)
- DO ERR
- 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)
- DO ERR
- End DoDot:1
- +3 KILL PXAERR
- +4 ;
- +5 ;
- +6 DO OTHER^PXAIPRV
- +7 ;
- +8 ;
- +9 IF $DATA(^TMP("PXK",$JOB))
- Begin DoDot:1
- +10 DO EN1^PXKMAIN
- +11 MERGE ERRRET=PXKERROR
- +12 DO PRIM^PXAIPRV
- KILL PRVDR
- +13 DO EVENT^PXKMAIN
- End DoDot:1
- +14 KILL ^TMP("PXK",$JOB),PXAERR,PXKERROR
- +15 QUIT $SELECT($GET(PXAERRF):-1,1:1)
- +16 ;
- +17 ;
- EXIT ;--EXIT AND CLEAN UP
- +1 DO EVENT^PXKMAIN
- +2 KILL ^TMP("PXK",$JOB),PRVDR
- +3 KILL PXAERR
- +4 QUIT
- +5 ;-----------------SUBROUTINES-----------------------
- ERR ;
- +1 ;
- +2 ;
- +3 IF '$DATA(PXADI("DIALOG"))
- QUIT
- +4 NEW NODE,SCREEN
- +5 SET PXAERR(1)=$GET(PXADATA)
- SET PXAERR(2)=$GET(PXAPKG)
- SET PXAERR(3)=$GET(PXASOURC)
- +6 SET PXAERR(4)=$GET(PXAVISIT)
- SET PXAERR(5)=$GET(PXAUSER)_" "_$PIECE($GET(^VA(200,PXAUSER,0)),"^",1)
- +7 IF $GET(PXANOT)=1
- DO EXTERNAL
- +8 IF '$TEST
- DO INTERNAL
- +9 DO ARRAY^PXAICPTV
- +10 KILL PXADI("DIALOG")
- +11 QUIT
- +12 ;
- EXTERNAL ;---SEND ERRORS TO SCREEN
- +1 WRITE !,"-----------------------------------------------------------------"
- +2 DO BLD^DIALOG($GET(PXADI("DIALOG")),.PXAERR,"","SCREEN","F")
- +3 DO MSG^DIALOG("ESW","",50,10,"SCREEN")
- +4 ;
- +5 QUIT
- INTERNAL ;---SET ERRORS TO GLOBAL ARRAY
- +1 SET NODE=PXADATA
- +2 DO BLD^DIALOG($GET(PXADI("DIALOG")),.PXAERR,.PXAERR,NODE,"F")
- +3 SET NODE=$NAME(@PXADATA@("DIERR",$JOB))
- DO MSG^DIALOG("ESW","",50,10,NODE)
- +4 QUIT
- +5 ;
- PROVDRST ; Check provider status (Primary or Secondary)
- +1 NEW PRVIEN,DETS,DIC,DR,DA,DIQ,PRI,PRVPRIM
- +2 IF $GET(PXAK)=""
- QUIT
- +3 SET PRVIEN=0
- +4 FOR
- SET PRVIEN=$ORDER(^AUPNVPRV("AD",PXAVISIT,PRVIEN))
- IF PRVIEN=""
- QUIT
- Begin DoDot:1
- +5 SET DETS=$GET(^AUPNVPRV(PRVIEN,0))
- +6 IF $PIECE(DETS,U)=$GET(@PXADATA@("PROVIDER",PXAK,"NAME"))
- Begin DoDot:2
- +7 SET DIC=9000010.06
- SET DR=.04
- SET DA=PRVIEN
- +8 SET DIQ="PRVPRIM("
- SET DIQ(0)="EI"
- DO EN^DIQ1
- +9 SET PRI=$EXTRACT($GET(PRVPRIM(9000010.06,DA,DR,"E")),1,1)
- +10 SET @PXADATA@("PROVIDER",PXAK,"PRIMARY")=$SELECT(PRI="P":1,1:0)
- End DoDot:2
- End DoDot:1
- +11 QUIT
- POVPRM(VISIT,PRIMFND,POVARR) ;
- +1 NEW PRVIEN,DETS,STOP,LPXAK,ORDX,NDX,ORDXP
- +2 SET PRVIEN=0
- +3 ;create array of existing DX; ORDX - pointer to ^ICD9(
- +4 FOR
- SET PRVIEN=$ORDER(^AUPNVPOV("AD",PXAVISIT,PRVIEN))
- IF PRVIEN=""
- QUIT
- Begin DoDot:1
- +5 SET DETS=$GET(^AUPNVPOV(PRVIEN,0))
- SET ORDX=$PIECE(DETS,U)
- +6 SET ORDX(ORDX)=PRVIEN
- IF $PIECE(DETS,U,12)="P"
- SET ORDXP(ORDX)=""
- End DoDot:1
- +7 ; create array of passed DX; NDX - pointer to ^ICD9(
- +8 SET PXAK=0
- FOR
- SET PXAK=$ORDER(@POVARR@("DX/PL",PXAK))
- IF PXAK=""
- QUIT
- Begin DoDot:1
- +9 SET NDX=$GET(@POVARR@("DX/PL",PXAK,"DIAGNOSIS"))
- SET NDX(NDX)=PXAK
- End DoDot:1
- +10 ; force entry of originally primary diagnosis with "S" flag
- +11 IF PRIMFND
- SET ORDX=""
- Begin DoDot:1
- +12 FOR
- SET ORDX=$ORDER(ORDXP(ORDX))
- IF ORDX=""
- QUIT
- IF PRIMFND'=ORDX
- Begin DoDot:2
- +13 IF $DATA(NDX(ORDX))
- SET @POVARR@("DX/PL",NDX(ORDX),"PRIMARY")=0
- +14 IF '$TEST
- Begin DoDot:3
- +15 SET LPXAK=$ORDER(@POVARR@("DX/PL",""),-1)
- +16 SET @POVARR@("DX/PL",LPXAK+1,"DIAGNOSIS")=ORDX
- +17 SET @POVARR@("DX/PL",LPXAK+1,"PRIMARY")=0
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +18 QUIT
- +19 ;
