PXAIXAM ;ISL/PKR - Set the EXAM nodes. ;03/18/2022
;;1.0;PCE PATIENT CARE ENCOUNTER;**45,211,217**;Aug 12, 1996;Build 134
;
EXAM ;Main entry point.
;
K PXAERR
S PXAERR(8)=PXAK
S PXAERR(7)="EXAM"
;
N IND,PXAA
S IND=""
F S IND=$O(@PXADATA@("EXAM",PXAK,IND)) Q:IND="" D
. S PXAA(IND)=@PXADATA@("EXAM",PXAK,IND)
;
;Validate the data.
N STOP
D VAL^PXAIXAMV
I $G(STOP) Q
;
SETVARA ;Set the after visit variables.
N AFTER0,AFTER12,AFTER220,AFTER811,AFTER812,ISNUM,MAGNITUDE
S $P(AFTER0,U,1)=$G(PXAA("EXAM"))
I $G(PXAA("DELETE")) S $P(AFTER0,U,1)="@"
S $P(AFTER0,U,2)=$G(PATIENT)
S $P(AFTER0,U,3)=$G(PXAVISIT)
S $P(AFTER0,U,4)=$G(PXAA("RESULT"))
S $P(AFTER12,U,1)=$G(PXAA("EVENT D/T"))
S $P(AFTER12,U,2)=$G(PXAA("ORD PROVIDER"))
S $P(AFTER12,U,4)=$G(PXAA("ENC PROVIDER"))
;
;Magnitude and UCUM code
S MAGNITUDE=$G(PXAA("MAGNITUDE"))
I MAGNITUDE'="" S $P(AFTER220,U,1)=MAGNITUDE,$P(AFTER220,U,2)=$P($G(^AUTTEXAM(PXAA("EXAM"),220)),U,4)
E S AFTER220=""
;
S $P(AFTER811,U,1)=$G(PXAA("COMMENT"))
;
;--PACKAGE AND SOURCE
S $P(AFTER812,"^",2)=$S($G(PXAA("PKG"))'="":PXAA("PKG"),1:$G(PXAPKG))
S $P(AFTER812,"^",3)=$S($G(PXAA("SOURCE"))'="":PXAA("SOURCE"),1:$G(PXASOURC))
;
S ^TMP("PXK",$J,"XAM",PXAK,0,"AFTER")=AFTER0
S ^TMP("PXK",$J,"XAM",PXAK,12,"AFTER")=AFTER12
S ^TMP("PXK",$J,"XAM",PXAK,220,"AFTER")=AFTER220
S ^TMP("PXK",$J,"XAM",PXAK,811,"AFTER")=AFTER811
S ^TMP("PXK",$J,"XAM",PXAK,812,"AFTER")=AFTER812
;
SETVARB ;Set the before variables.
N BEFOR0,BEFOR12,BEFOR220,BEFOR811,BEFOR812
N IENB,PXAAX,PXBCNT,PXBKY,PXBSKY,PXBSAM
D EXAM^PXBGXAM(PXAVISIT)
;
S IENB=""
I PXBCNT>0 D
. S PXAAX("EXAM")=$P($G(^AUTTEXAM(PXAA("EXAM"),0)),U,1)
. S IENB=$O(PXBKY(PXAAX("EXAM"),IENB))
I $G(IENB) D
. S BEFOR0=$G(^AUPNVXAM(IENB,0))
. S BEFOR12=$G(^AUPNVXAM(IENB,12))
. S BEFOR220=$G(^AUPNVXAM(IENB,220))
. S BEFOR811=$G(^AUPNVXAM(IENB,811))
. S BEFOR812=$G(^AUPNVXAM(IENB,812))
E S (BEFOR0,BEFOR11,BEFOR12,BEFOR220,BEFOR811,BEFOR812)=""
;
S ^TMP("PXK",$J,"XAM",PXAK,0,"BEFORE")=BEFOR0
S ^TMP("PXK",$J,"XAM",PXAK,12,"BEFORE")=BEFOR12
S ^TMP("PXK",$J,"XAM",PXAK,220,"BEFORE")=BEFOR220
S ^TMP("PXK",$J,"XAM",PXAK,811,"BEFORE")=BEFOR811
S ^TMP("PXK",$J,"XAM",PXAK,812,"BEFORE")=BEFOR812
S ^TMP("PXK",$J,"XAM",PXAK,"IEN")=IENB
;
;Package and Data Source cannot be edited.
S BEFOR812=^TMP("PXK",$J,"XAM",PXAK,812,"BEFORE")
I BEFOR812'="" D
. I AFTER812=BEFOR812 Q
. I $P(BEFOR812,U,2)'="" S $P(AFTER812,U,2)=$P(BEFOR812,U,2)
. I $P(BEFOR812,U,3)'="" S $P(AFTER812,U,3)=$P(BEFOR812,U,3)
. S ^TMP("PXK",$J,"XAM",PXAK,812,"AFTER")=AFTER812
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAIXAM 2672 printed Nov 22, 2024@17:36:09 Page 2
PXAIXAM ;ISL/PKR - Set the EXAM nodes. ;03/18/2022
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**45,211,217**;Aug 12, 1996;Build 134
+2 ;
EXAM ;Main entry point.
+1 ;
+2 KILL PXAERR
+3 SET PXAERR(8)=PXAK
+4 SET PXAERR(7)="EXAM"
+5 ;
+6 NEW IND,PXAA
+7 SET IND=""
+8 FOR
SET IND=$ORDER(@PXADATA@("EXAM",PXAK,IND))
if IND=""
QUIT
Begin DoDot:1
+9 SET PXAA(IND)=@PXADATA@("EXAM",PXAK,IND)
End DoDot:1
+10 ;
+11 ;Validate the data.
+12 NEW STOP
+13 DO VAL^PXAIXAMV
+14 IF $GET(STOP)
QUIT
+15 ;
SETVARA ;Set the after visit variables.
+1 NEW AFTER0,AFTER12,AFTER220,AFTER811,AFTER812,ISNUM,MAGNITUDE
+2 SET $PIECE(AFTER0,U,1)=$GET(PXAA("EXAM"))
+3 IF $GET(PXAA("DELETE"))
SET $PIECE(AFTER0,U,1)="@"
+4 SET $PIECE(AFTER0,U,2)=$GET(PATIENT)
+5 SET $PIECE(AFTER0,U,3)=$GET(PXAVISIT)
+6 SET $PIECE(AFTER0,U,4)=$GET(PXAA("RESULT"))
+7 SET $PIECE(AFTER12,U,1)=$GET(PXAA("EVENT D/T"))
+8 SET $PIECE(AFTER12,U,2)=$GET(PXAA("ORD PROVIDER"))
+9 SET $PIECE(AFTER12,U,4)=$GET(PXAA("ENC PROVIDER"))
+10 ;
+11 ;Magnitude and UCUM code
+12 SET MAGNITUDE=$GET(PXAA("MAGNITUDE"))
+13 IF MAGNITUDE'=""
SET $PIECE(AFTER220,U,1)=MAGNITUDE
SET $PIECE(AFTER220,U,2)=$PIECE($GET(^AUTTEXAM(PXAA("EXAM"),220)),U,4)
+14 IF '$TEST
SET AFTER220=""
+15 ;
+16 SET $PIECE(AFTER811,U,1)=$GET(PXAA("COMMENT"))
+17 ;
+18 ;--PACKAGE AND SOURCE
+19 SET $PIECE(AFTER812,"^",2)=$SELECT($GET(PXAA("PKG"))'="":PXAA("PKG"),1:$GET(PXAPKG))
+20 SET $PIECE(AFTER812,"^",3)=$SELECT($GET(PXAA("SOURCE"))'="":PXAA("SOURCE"),1:$GET(PXASOURC))
+21 ;
+22 SET ^TMP("PXK",$JOB,"XAM",PXAK,0,"AFTER")=AFTER0
+23 SET ^TMP("PXK",$JOB,"XAM",PXAK,12,"AFTER")=AFTER12
+24 SET ^TMP("PXK",$JOB,"XAM",PXAK,220,"AFTER")=AFTER220
+25 SET ^TMP("PXK",$JOB,"XAM",PXAK,811,"AFTER")=AFTER811
+26 SET ^TMP("PXK",$JOB,"XAM",PXAK,812,"AFTER")=AFTER812
+27 ;
SETVARB ;Set the before variables.
+1 NEW BEFOR0,BEFOR12,BEFOR220,BEFOR811,BEFOR812
+2 NEW IENB,PXAAX,PXBCNT,PXBKY,PXBSKY,PXBSAM
+3 DO EXAM^PXBGXAM(PXAVISIT)
+4 ;
+5 SET IENB=""
+6 IF PXBCNT>0
Begin DoDot:1
+7 SET PXAAX("EXAM")=$PIECE($GET(^AUTTEXAM(PXAA("EXAM"),0)),U,1)
+8 SET IENB=$ORDER(PXBKY(PXAAX("EXAM"),IENB))
End DoDot:1
+9 IF $GET(IENB)
Begin DoDot:1
+10 SET BEFOR0=$GET(^AUPNVXAM(IENB,0))
+11 SET BEFOR12=$GET(^AUPNVXAM(IENB,12))
+12 SET BEFOR220=$GET(^AUPNVXAM(IENB,220))
+13 SET BEFOR811=$GET(^AUPNVXAM(IENB,811))
+14 SET BEFOR812=$GET(^AUPNVXAM(IENB,812))
End DoDot:1
+15 IF '$TEST
SET (BEFOR0,BEFOR11,BEFOR12,BEFOR220,BEFOR811,BEFOR812)=""
+16 ;
+17 SET ^TMP("PXK",$JOB,"XAM",PXAK,0,"BEFORE")=BEFOR0
+18 SET ^TMP("PXK",$JOB,"XAM",PXAK,12,"BEFORE")=BEFOR12
+19 SET ^TMP("PXK",$JOB,"XAM",PXAK,220,"BEFORE")=BEFOR220
+20 SET ^TMP("PXK",$JOB,"XAM",PXAK,811,"BEFORE")=BEFOR811
+21 SET ^TMP("PXK",$JOB,"XAM",PXAK,812,"BEFORE")=BEFOR812
+22 SET ^TMP("PXK",$JOB,"XAM",PXAK,"IEN")=IENB
+23 ;
+24 ;Package and Data Source cannot be edited.
+25 SET BEFOR812=^TMP("PXK",$JOB,"XAM",PXAK,812,"BEFORE")
+26 IF BEFOR812'=""
Begin DoDot:1
+27 IF AFTER812=BEFOR812
QUIT
+28 IF $PIECE(BEFOR812,U,2)'=""
SET $PIECE(AFTER812,U,2)=$PIECE(BEFOR812,U,2)
+29 IF $PIECE(BEFOR812,U,3)'=""
SET $PIECE(AFTER812,U,3)=$PIECE(BEFOR812,U,3)
+30 SET ^TMP("PXK",$JOB,"XAM",PXAK,812,"AFTER")=AFTER812
End DoDot:1
+31 ;
+32 QUIT
