Routine: PXAIPED

PXAIPED ;ISL/PKR - Set the PATIENT EDUCATION nodes. ;03/18/2022

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**45,211,217**;Aug 12, 1996;Build 134

EDU ;Main entry point.

 K PXAERR

 S PXAERR(8)=PXAK

 S PXAERR(7)="PATIENT EDUCATION"

 N IND,PXAA

 S IND=""

 F  S IND=$O(@PXADATA@("PATIENT ED",PXAK,IND)) Q:IND=""  D

 . S PXAA(IND)=@PXADATA@("PATIENT ED",PXAK,IND)

 ;Validate the data.

 N STOP

 D VAL^PXAIPEDV

 I $G(STOP) Q

SETVARA ;Set the after visit variables.

 N AFTER0,AFTER12,AFTER220,AFTER811,AFTER812,MAGNITUDE

 S $P(AFTER0,U,1)=$G(PXAA("TOPIC"))

 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,6)=$G(PXAA("UNDERSTANDING"))

 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(^AUTTEDT(PXAA("TOPIC"),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,"PED",PXAK,0,"AFTER")=AFTER0

 S ^TMP("PXK",$J,"PED",PXAK,12,"AFTER")=AFTER12

 S ^TMP("PXK",$J,"PED",PXAK,220,"AFTER")=AFTER220

 S ^TMP("PXK",$J,"PED",PXAK,811,"AFTER")=AFTER811

 S ^TMP("PXK",$J,"PED",PXAK,812,"AFTER")=AFTER812

SETVARB ;Set the before variables.

 N BEFOR0,BEFOR12,BEFOR220,BEFOR811,BEFOR812

 N IENB,PXAAX,PXBCNT,PXBKY,PXBSKY,PXBSAM

 D EDU^PXBGPED(PXAVISIT)

 S IENB=""

 I PXBCNT>0 D

 . S PXAAX("TOPIC")=$P($G(^AUTTEDT(PXAA("TOPIC"),0)),U,1)

 . S IENB=$O(PXBKY(PXAAX("TOPIC"),IENB))

 I $G(IENB) D

 . S BEFOR0=$G(^AUPNVPED(IENB,0))

 . S BEFOR12=$G(^AUPNVPED(IENB,12))

 . S BEFOR220=$G(^AUPNVPED(IENB,220))

 . S BEFOR811=$G(^AUPNVPED(IENB,811))

 . S BEFOR812=$G(^AUPNVPED(IENB,812))

 E  S (BEFOR0,BEFOR11,BEFOR12,BEFOR220,BEFOR811,BEFOR812)=""

 S ^TMP("PXK",$J,"PED",PXAK,0,"BEFORE")=BEFOR0

 S ^TMP("PXK",$J,"PED",PXAK,12,"BEFORE")=BEFOR12

 S ^TMP("PXK",$J,"PED",PXAK,220,"BEFORE")=BEFOR220

 S ^TMP("PXK",$J,"PED",PXAK,811,"BEFORE")=BEFOR811

 S ^TMP("PXK",$J,"PED",PXAK,812,"BEFORE")=BEFOR812

 S ^TMP("PXK",$J,"PED",PXAK,"IEN")=IENB

 ;Package and Data Source cannot be edited.

 S BEFOR812=^TMP("PXK",$J,"PED",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,"PED",PXAK,812,"AFTER")=AFTER812

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAIPED   2712     printed  Feb 18, 2025@23:52:12                                                                                                                                                                                                     Page 2

PXAIPED   ;ISL/PKR - Set the PATIENT EDUCATION nodes. ;03/18/2022

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**45,211,217**;Aug 12, 1996;Build 134

 +2       ;

EDU       ;Main entry point.

 +1       ;

 +2        KILL PXAERR

 +3        SET PXAERR(8)=PXAK

 +4        SET PXAERR(7)="PATIENT EDUCATION"

 +5       ;

 +6        NEW IND,PXAA

 +7        SET IND=""

 +8        FOR

               SET IND=$ORDER(@PXADATA@("PATIENT ED",PXAK,IND))

               if IND=""

                   QUIT

               Begin DoDot:1

 +9                SET PXAA(IND)=@PXADATA@("PATIENT ED",PXAK,IND)

               End DoDot:1

 +10      ;

 +11      ;Validate the data.

 +12       NEW STOP

 +13       DO VAL^PXAIPEDV

 +14       IF $GET(STOP)

               QUIT

 +15      ;

SETVARA   ;Set the after visit variables.

 +1        NEW AFTER0,AFTER12,AFTER220,AFTER811,AFTER812,MAGNITUDE

 +2        SET $PIECE(AFTER0,U,1)=$GET(PXAA("TOPIC"))

 +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,6)=$GET(PXAA("UNDERSTANDING"))

 +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(^AUTTEDT(PXAA("TOPIC"),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,"PED",PXAK,0,"AFTER")=AFTER0

 +23       SET ^TMP("PXK",$JOB,"PED",PXAK,12,"AFTER")=AFTER12

 +24       SET ^TMP("PXK",$JOB,"PED",PXAK,220,"AFTER")=AFTER220

 +25       SET ^TMP("PXK",$JOB,"PED",PXAK,811,"AFTER")=AFTER811

 +26       SET ^TMP("PXK",$JOB,"PED",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 EDU^PXBGPED(PXAVISIT)

 +4       ;

 +5        SET IENB=""

 +6        IF PXBCNT>0

               Begin DoDot:1

 +7                SET PXAAX("TOPIC")=$PIECE($GET(^AUTTEDT(PXAA("TOPIC"),0)),U,1)

 +8                SET IENB=$ORDER(PXBKY(PXAAX("TOPIC"),IENB))

               End DoDot:1

 +9        IF $GET(IENB)

               Begin DoDot:1

 +10               SET BEFOR0=$GET(^AUPNVPED(IENB,0))

 +11               SET BEFOR12=$GET(^AUPNVPED(IENB,12))

 +12               SET BEFOR220=$GET(^AUPNVPED(IENB,220))

 +13               SET BEFOR811=$GET(^AUPNVPED(IENB,811))

 +14               SET BEFOR812=$GET(^AUPNVPED(IENB,812))

               End DoDot:1

 +15      IF '$TEST

               SET (BEFOR0,BEFOR11,BEFOR12,BEFOR220,BEFOR811,BEFOR812)=""

 +16      ;

 +17       SET ^TMP("PXK",$JOB,"PED",PXAK,0,"BEFORE")=BEFOR0

 +18       SET ^TMP("PXK",$JOB,"PED",PXAK,12,"BEFORE")=BEFOR12

 +19       SET ^TMP("PXK",$JOB,"PED",PXAK,220,"BEFORE")=BEFOR220

 +20       SET ^TMP("PXK",$JOB,"PED",PXAK,811,"BEFORE")=BEFOR811

 +21       SET ^TMP("PXK",$JOB,"PED",PXAK,812,"BEFORE")=BEFOR812

 +22       SET ^TMP("PXK",$JOB,"PED",PXAK,"IEN")=IENB

 +23      ;

 +24      ;Package and Data Source cannot be edited.

 +25       SET BEFOR812=^TMP("PXK",$JOB,"PED",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,"PED",PXAK,812,"AFTER")=AFTER812

               End DoDot:1

 +31      ;

 +32       QUIT

PXAIPED.m