Routine: PXAIPOV

PXAIPOV ;ISL/JVS,PKR,ESW - SET THE DIAGNOSIS/PROBLEM LIST NODES ;09/14/2021

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**28,73,69,108,112,130,124,174,168,203,199,211,228**;Aug 12, 1996;Build 1

POV ;--CREATE DIAGNOSIS

SET ;--SET AND NEW VARIABLES

 N AFTER0,AFTER12,AFTER800,AFTER801,AFTER802,AFTER811,AFTER812,AFTER8A

 N BEFOR0,BEFOR12,BEFOR800,BEFOR801,BEFOR802,BEFOR811,BEFOR812,FPRI

 N EVENTDT,GMPSAVED,IENB,J,LNARR,NOPLLIST,PIECE,POVI,PRI,PRVDR,PXAA,PXAAX,PXAB

 N PXAIVDT,PXBCNT,PXBCNTPL,PXBKY,PXBPMT,PXBSAM,PXBSKY,PXDIGNS,PXKDONE

 N STOP,SUB,VAR

 K PXAERR

 S PXAERR(8)=PXAK

 S PXAERR(7)="DX/PL"

 S SUB="" F  S SUB=$O(@PXADATA@("DX/PL",PXAK,SUB)) Q:SUB=""  D

 .S PXAA(SUB)=@PXADATA@("DX/PL",PXAK,SUB)

 ;--VALIDATE ENOUGH DATA

 D VAL^PXAIPOVV Q:$G(STOP)=1

SETVARA ;--SET VISIT VARIABLES

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

 I $G(PXAA("DELETE")) S $P(AFTER0,U,1)="@"

 S $P(AFTER0,U,2)=$G(PATIENT),PXAA("PATIENT")=$G(PATIENT)

 S $P(AFTER0,U,3)=$G(PXAVISIT)

 ;If Provider Narrative is not passed it is generated in VAL^PXAIPOVV.

 S $P(AFTER0,U,4)=+$$PROVNARR^PXAPI($G(PXAA("NARRATIVE")),9000010.07)

 I $P(AFTER0,U,4)'>0 D VAL04^PXAIPOVV,ERR^PXAI("NARRATIVE",1) Q:$D(STOP)

 ;PX*1*124

 S PRI=$G(PXAA("PRIMARY"))

 S $P(AFTER0,U,12)=$S(PRI=1:"P",PRI="P":"P",1:"S")

 ;--ADDED FOR PATCH 28

 S $P(AFTER0,U,15)=$G(PXAA("LEXICON TERM"))

 S $P(AFTER0,U,16)=$G(PXAA("PL IEN"))

 S $P(AFTER0,U,17)=$G(PXAA("ORD/RES"))

 ;--END OF NEW PATCH 28

 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"))

 ;PX*1*108

 I $G(PXAA("ENC PROVIDER"))]"",'$G(PXAA("DELETE")) D

 .S ^TMP("PXAIADDPRV",$J,$G(PXAA("ENC PROVIDER")))="ENC"

 I $G(PXAA("ORD PROVIDER"))]"",'$G(PXAA("DELETE")) D

 .S ^TMP("PXAIADDPRV",$J,$G(PXAA("ORD PROVIDER")))="ORD"

 I $G(PXAA("CATEGORY"))="" S $P(AFTER802,U,1)=""

 E  D

 . S $P(AFTER802,U,1)=+$$PROVNARR^PXAPI(PXAA("CATEGORY"),9000010.07)

 . I $P(AFTER802,U,1)'>0 D

 .. D VAL802^PXAIPOVV,ERR^PXAI("CATEGORY",1)

 .. S $P(AFTER802,U,1)=""

 S $P(AFTER811,U,1)=$G(PXAA("COMMENT"))

 S $P(AFTER800,U,1)=$G(PXAA("PL SC"))

 S $P(AFTER800,U,2)=$G(PXAA("PL AO"))

 S $P(AFTER800,U,3)=$G(PXAA("PL IR"))

 S $P(AFTER800,U,4)=$G(PXAA("PL EC"))

 S $P(AFTER800,U,5)=$G(PXAA("PL MST"))

 S $P(AFTER800,U,6)=$G(PXAA("PL HNC"))

 S $P(AFTER800,U,7)=$G(PXAA("PL CV"))

 S $P(AFTER800,U,8)=$G(PXAA("PL SHAD"))

 D SCC^PXUTLSCC(PATIENT,$P($G(^AUPNVSIT(PXAVISIT,0)),U,1),$P($G(^AUPNVSIT(PXAVISIT,0)),U,22),$G(PXAVISIT),AFTER800,.AFTER800)

 I $G(PXAA("PL SC"))="" S $P(AFTER800,U,1)=""

 I $G(PXAA("PL AO"))="" S $P(AFTER800,U,2)=""

 I $G(PXAA("PL IR"))="" S $P(AFTER800,U,3)=""

 I $G(PXAA("PL EC"))="" S $P(AFTER800,U,4)=""

 I $G(PXAA("PL MST"))="" S $P(AFTER800,U,5)=""

 I $G(PXAA("PL HNC"))="" S $P(AFTER800,U,6)=""

 I $G(PXAA("PL CV"))="" S $P(AFTER800,U,7)=""

 I $G(PXAA("PL SHAD"))="" S $P(AFTER800,U,8)=""

 S $P(AFTER812,U,2)=$S($G(PXAA("PKG"))'="":PXAA("PKG"),1:$G(PXAPKG))

 S $P(AFTER812,U,3)=$S($G(PXAA("SOURCE"))'="":PXAA("SOURCE"),1:$G(PXASOURC))

 D PL^PXAIPL

SETPXKA ;--SET PXK ARRAY AFTER

 S ^TMP("PXK",$J,"POV",PXAK,0,"AFTER")=$G(AFTER0)

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

 S ^TMP("PXK",$J,"POV",PXAK,800,"AFTER")=$G(AFTER800)

 S ^TMP("PXK",$J,"POV",PXAK,802,"AFTER")=$G(AFTER802)

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

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

SETVARB ;--SET VARIABLES BEFORE

 ;--GET IEN FOR 'PXK NODE'

 D POV^PXBGPOV(PXAVISIT)

 I $D(^TMP("PXBGPOVMATCH",$J,$G(PXAA("DIAGNOSIS")))) D

 .S (^TMP("PXK",$J,"POV",PXAK,"IEN"),IENB)=$O(^TMP("PXBGPOVMATCH",$J,$G(PXAA("DIAGNOSIS")),0))

 K ^TMP("PXBGPOVMATCH",$J)

BEFOR ;

 I $G(IENB) D

 .F PIECE=0,12,800,802,811,812 S ^TMP("PXK",$J,"POV",PXAK,PIECE,"BEFORE")=$G(^AUPNVPOV(IENB,PIECE))

 E  D

 .S (BEFOR0,BEFOR12,BEFOR800,BEFOR802,BEFOR811,BEFOR812)=""

.;

SETPXKB .;--SET PXK ARRAY BEFORE

 .S ^TMP("PXK",$J,"POV",PXAK,0,"BEFORE")=$G(BEFOR0)

 .S ^TMP("PXK",$J,"POV",PXAK,12,"BEFORE")=$G(BEFOR12)

 .S ^TMP("PXK",$J,"POV",PXAK,800,"BEFORE")=$G(BEFOR800)

 .S ^TMP("PXK",$J,"POV",PXAK,802,"BEFORE")=$G(BEFOR802)

 .S ^TMP("PXK",$J,"POV",PXAK,811,"BEFORE")=$G(BEFOR811)

 .S ^TMP("PXK",$J,"POV",PXAK,812,"BEFORE")=$G(BEFOR812)

 .S ^TMP("PXK",$J,"POV",PXAK,"IEN")=""

 ;Package and Data Source cannot be edited.

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

MISC ;--MISCELLANEOUS NODE

PRIM ;--SET A PROVIDER AS PRIMARY

 ;THIS IS NOT CALLED ANYMORE.

 N PXBCNT,PXBKY,PXBSAM,PXBSKY,PRVDR,FPRI ;108

 D PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI) ;108

 I $D(PRVDR) Q

 I '$D(PXBSKY) Q

 S $P(AFTER0,U,1)=$P(^AUPNVPRV($O(PXBSKY(1,0)),0),U,1)

 S $P(AFTER0,U,2)=$P(^AUPNVSIT(PXAVISIT,0),U,5)

 S $P(AFTER0,U,3)=PXAVISIT

 S $P(AFTER0,U,4)="P"

 S ^TMP("PXK",$J,"PRV",22222,0,"AFTER")=AFTER0

 S ^TMP("PXK",$J,"PRV",22222,0,"BEFORE")=$G(^AUPNVPRV($O(PXBSKY(1,0)),0))

 S ^TMP("PXK",$J,"PRV",22222,"IEN")=$O(PXBSKY(1,0))

 D EN1^PXKMAIN

 K PXRDR

 K ^TMP("PXBGPOVMATCH",$J)

SPOVPRIM(PXADATA,VISITIEN,PXAERR) ;If there is an exisiting primary diagnosis

 ;change it to secondary so the new primary can be set.

 N DIAG,IND,PDNEW

 S IND=0,PDNEW=""

 F  S IND=+$O(@PXADATA@("DX/PL",IND)) Q:IND=0  D

 . S DIAG=$G(@PXADATA@("DX/PL",IND,"DIAGNOSIS"))

 . I DIAG="" Q

 . I $G(@PXADATA@("DX/PL",IND,"PRIMARY"))=1 S PDNEW=DIAG

 I PDNEW="" Q

 ;There is a new primary diagnosis, set any existing primary to

 ;secondary.

 N FDA,IENS,MSG

 S IND=0

 F  S IND=$O(^AUPNVPOV("AD",VISITIEN,IND)) Q:IND=""  D

 . I $P(^AUPNVPOV(IND,0),U,12)="P" D

 .. S IENS=IND_","

 .. S FDA(9000010.07,IENS,.12)="S"

 .. D FILE^DIE("","FDA","MSG")

 .. I $D(MSG) D  Q

 ... S PXAERR(9)="V POV PRIMARY DIAGNOSIS CHANGE"

 ... S PXAERR(12)=MSG("DIERR",1,"TEXT",1)

 ... S PXAERR(13)="IENS="_IENS

 ... D ERRSET^PXAIPOVV

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAIPOV   6206     printed  Mar 13, 2025@21:30:41                                                                                                                                                                                                     Page 2

PXAIPOV   ;ISL/JVS,PKR,ESW - SET THE DIAGNOSIS/PROBLEM LIST NODES ;09/14/2021

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**28,73,69,108,112,130,124,174,168,203,199,211,228**;Aug 12, 1996;Build 1

 +2       ;

 +3        QUIT

POV       ;--CREATE DIAGNOSIS

 +1       ;

SET       ;--SET AND NEW VARIABLES

 +1        NEW AFTER0,AFTER12,AFTER800,AFTER801,AFTER802,AFTER811,AFTER812,AFTER8A

 +2        NEW BEFOR0,BEFOR12,BEFOR800,BEFOR801,BEFOR802,BEFOR811,BEFOR812,FPRI

 +3        NEW EVENTDT,GMPSAVED,IENB,J,LNARR,NOPLLIST,PIECE,POVI,PRI,PRVDR,PXAA,PXAAX,PXAB

 +4        NEW PXAIVDT,PXBCNT,PXBCNTPL,PXBKY,PXBPMT,PXBSAM,PXBSKY,PXDIGNS,PXKDONE

 +5        NEW STOP,SUB,VAR

 +6       ;

 +7        KILL PXAERR

 +8        SET PXAERR(8)=PXAK

 +9        SET PXAERR(7)="DX/PL"

 +10      ;

 +11       SET SUB=""

FOR

               SET SUB=$ORDER(@PXADATA@("DX/PL",PXAK,SUB))

               if SUB=""

                   QUIT

               Begin DoDot:1

 +12               SET PXAA(SUB)=@PXADATA@("DX/PL",PXAK,SUB)

               End DoDot:1

 +13      ;

 +14      ;--VALIDATE ENOUGH DATA

 +15       DO VAL^PXAIPOVV

           if $GET(STOP)=1

               QUIT

 +16      ;

SETVARA   ;--SET VISIT VARIABLES

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

 +2        IF $GET(PXAA("DELETE"))

               SET $PIECE(AFTER0,U,1)="@"

 +3        SET $PIECE(AFTER0,U,2)=$GET(PATIENT)

           SET PXAA("PATIENT")=$GET(PATIENT)

 +4        SET $PIECE(AFTER0,U,3)=$GET(PXAVISIT)

 +5       ;If Provider Narrative is not passed it is generated in VAL^PXAIPOVV.

 +6        SET $PIECE(AFTER0,U,4)=+$$PROVNARR^PXAPI($GET(PXAA("NARRATIVE")),9000010.07)

 +7        IF $PIECE(AFTER0,U,4)'>0

               DO VAL04^PXAIPOVV

               DO ERR^PXAI("NARRATIVE",1)

               if $DATA(STOP)

                   QUIT

 +8       ;PX*1*124

 +9        SET PRI=$GET(PXAA("PRIMARY"))

 +10       SET $PIECE(AFTER0,U,12)=$SELECT(PRI=1:"P",PRI="P":"P",1:"S")

 +11      ;--ADDED FOR PATCH 28

 +12       SET $PIECE(AFTER0,U,15)=$GET(PXAA("LEXICON TERM"))

 +13       SET $PIECE(AFTER0,U,16)=$GET(PXAA("PL IEN"))

 +14       SET $PIECE(AFTER0,U,17)=$GET(PXAA("ORD/RES"))

 +15      ;--END OF NEW PATCH 28

 +16       SET $PIECE(AFTER12,U,1)=$GET(PXAA("EVENT D/T"))

 +17       SET $PIECE(AFTER12,U,2)=$GET(PXAA("ORD PROVIDER"))

 +18       SET $PIECE(AFTER12,U,4)=$GET(PXAA("ENC PROVIDER"))

 +19      ;PX*1*108

 +20       IF $GET(PXAA("ENC PROVIDER"))]""

               IF '$GET(PXAA("DELETE"))

                   Begin DoDot:1

 +21                   SET ^TMP("PXAIADDPRV",$JOB,$GET(PXAA("ENC PROVIDER")))="ENC"

                   End DoDot:1

 +22       IF $GET(PXAA("ORD PROVIDER"))]""

               IF '$GET(PXAA("DELETE"))

                   Begin DoDot:1

 +23                   SET ^TMP("PXAIADDPRV",$JOB,$GET(PXAA("ORD PROVIDER")))="ORD"

                   End DoDot:1

 +24      ;

 +25       IF $GET(PXAA("CATEGORY"))=""

               SET $PIECE(AFTER802,U,1)=""

 +26      IF '$TEST

               Begin DoDot:1

 +27               SET $PIECE(AFTER802,U,1)=+$$PROVNARR^PXAPI(PXAA("CATEGORY"),9000010.07)

 +28               IF $PIECE(AFTER802,U,1)'>0

                       Begin DoDot:2

 +29                       DO VAL802^PXAIPOVV

                           DO ERR^PXAI("CATEGORY",1)

 +30                       SET $PIECE(AFTER802,U,1)=""

                       End DoDot:2

               End DoDot:1

 +31      ;

 +32       SET $PIECE(AFTER811,U,1)=$GET(PXAA("COMMENT"))

 +33      ;

 +34       SET $PIECE(AFTER800,U,1)=$GET(PXAA("PL SC"))

 +35       SET $PIECE(AFTER800,U,2)=$GET(PXAA("PL AO"))

 +36       SET $PIECE(AFTER800,U,3)=$GET(PXAA("PL IR"))

 +37       SET $PIECE(AFTER800,U,4)=$GET(PXAA("PL EC"))

 +38       SET $PIECE(AFTER800,U,5)=$GET(PXAA("PL MST"))

 +39       SET $PIECE(AFTER800,U,6)=$GET(PXAA("PL HNC"))

 +40       SET $PIECE(AFTER800,U,7)=$GET(PXAA("PL CV"))

 +41       SET $PIECE(AFTER800,U,8)=$GET(PXAA("PL SHAD"))

 +42      ;

 +43       DO SCC^PXUTLSCC(PATIENT,$PIECE($GET(^AUPNVSIT(PXAVISIT,0)),U,1),$PIECE($GET(^AUPNVSIT(PXAVISIT,0)),U,22),$GET(PXAVISIT),AFTER800,.AFTER800)

 +44      ;

 +45       IF $GET(PXAA("PL SC"))=""

               SET $PIECE(AFTER800,U,1)=""

 +46       IF $GET(PXAA("PL AO"))=""

               SET $PIECE(AFTER800,U,2)=""

 +47       IF $GET(PXAA("PL IR"))=""

               SET $PIECE(AFTER800,U,3)=""

 +48       IF $GET(PXAA("PL EC"))=""

               SET $PIECE(AFTER800,U,4)=""

 +49       IF $GET(PXAA("PL MST"))=""

               SET $PIECE(AFTER800,U,5)=""

 +50       IF $GET(PXAA("PL HNC"))=""

               SET $PIECE(AFTER800,U,6)=""

 +51       IF $GET(PXAA("PL CV"))=""

               SET $PIECE(AFTER800,U,7)=""

 +52       IF $GET(PXAA("PL SHAD"))=""

               SET $PIECE(AFTER800,U,8)=""

 +53      ;

 +54       SET $PIECE(AFTER812,U,2)=$SELECT($GET(PXAA("PKG"))'="":PXAA("PKG"),1:$GET(PXAPKG))

 +55       SET $PIECE(AFTER812,U,3)=$SELECT($GET(PXAA("SOURCE"))'="":PXAA("SOURCE"),1:$GET(PXASOURC))

 +56      ;

 +57       DO PL^PXAIPL

 +58      ;

 +59      ;

SETPXKA   ;--SET PXK ARRAY AFTER

 +1        SET ^TMP("PXK",$JOB,"POV",PXAK,0,"AFTER")=$GET(AFTER0)

 +2        SET ^TMP("PXK",$JOB,"POV",PXAK,12,"AFTER")=$GET(AFTER12)

 +3        SET ^TMP("PXK",$JOB,"POV",PXAK,800,"AFTER")=$GET(AFTER800)

 +4        SET ^TMP("PXK",$JOB,"POV",PXAK,802,"AFTER")=$GET(AFTER802)

 +5        SET ^TMP("PXK",$JOB,"POV",PXAK,811,"AFTER")=$GET(AFTER811)

 +6        SET ^TMP("PXK",$JOB,"POV",PXAK,812,"AFTER")=$GET(AFTER812)

 +7       ;

SETVARB   ;--SET VARIABLES BEFORE

 +1       ;

 +2       ;--GET IEN FOR 'PXK NODE'

 +3        DO POV^PXBGPOV(PXAVISIT)

 +4        IF $DATA(^TMP("PXBGPOVMATCH",$JOB,$GET(PXAA("DIAGNOSIS"))))

               Begin DoDot:1

 +5                SET (^TMP("PXK",$JOB,"POV",PXAK,"IEN"),IENB)=$ORDER(^TMP("PXBGPOVMATCH",$JOB,$GET(PXAA("DIAGNOSIS")),0))

               End DoDot:1

 +6        KILL ^TMP("PXBGPOVMATCH",$JOB)

 +7       ;

BEFOR     ;

 +1        IF $GET(IENB)

               Begin DoDot:1

 +2                FOR PIECE=0,12,800,802,811,812

                       SET ^TMP("PXK",$JOB,"POV",PXAK,PIECE,"BEFORE")=$GET(^AUPNVPOV(IENB,PIECE))

               End DoDot:1

 +3       IF '$TEST

               Begin DoDot:1

 +4                SET (BEFOR0,BEFOR12,BEFOR800,BEFOR802,BEFOR811,BEFOR812)=""

 +5       ;

SETPXKB   ;--SET PXK ARRAY BEFORE

 +1                SET ^TMP("PXK",$JOB,"POV",PXAK,0,"BEFORE")=$GET(BEFOR0)

 +2                SET ^TMP("PXK",$JOB,"POV",PXAK,12,"BEFORE")=$GET(BEFOR12)

 +3                SET ^TMP("PXK",$JOB,"POV",PXAK,800,"BEFORE")=$GET(BEFOR800)

 +4                SET ^TMP("PXK",$JOB,"POV",PXAK,802,"BEFORE")=$GET(BEFOR802)

 +5                SET ^TMP("PXK",$JOB,"POV",PXAK,811,"BEFORE")=$GET(BEFOR811)

 +6                SET ^TMP("PXK",$JOB,"POV",PXAK,812,"BEFORE")=$GET(BEFOR812)

 +7                SET ^TMP("PXK",$JOB,"POV",PXAK,"IEN")=""

               End DoDot:1

 +8       ;

 +9       ;Package and Data Source cannot be edited.

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

 +11       IF BEFOR812'=""

               Begin DoDot:1

 +12               IF AFTER812=BEFOR812

                       QUIT

 +13               IF $PIECE(BEFOR812,U,2)'=""

                       SET $PIECE(AFTER812,U,2)=$PIECE(BEFOR812,U,2)

 +14               IF $PIECE(BEFOR812,U,3)'=""

                       SET $PIECE(AFTER812,U,3)=$PIECE(BEFOR812,U,3)

 +15               SET ^TMP("PXK",$JOB,"POV",PXAK,812,"AFTER")=AFTER812

               End DoDot:1

 +16      ;

MISC      ;--MISCELLANEOUS NODE

 +1       ;

 +2        QUIT

 +3       ;

PRIM      ;--SET A PROVIDER AS PRIMARY

 +1       ;THIS IS NOT CALLED ANYMORE.

 +2       ;108

           NEW PXBCNT,PXBKY,PXBSAM,PXBSKY,PRVDR,FPRI

 +3       ;108

           DO PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)

 +4        IF $DATA(PRVDR)

               QUIT

 +5        IF '$DATA(PXBSKY)

               QUIT

 +6       ;

 +7        SET $PIECE(AFTER0,U,1)=$PIECE(^AUPNVPRV($ORDER(PXBSKY(1,0)),0),U,1)

 +8        SET $PIECE(AFTER0,U,2)=$PIECE(^AUPNVSIT(PXAVISIT,0),U,5)

 +9        SET $PIECE(AFTER0,U,3)=PXAVISIT

 +10       SET $PIECE(AFTER0,U,4)="P"

 +11       SET ^TMP("PXK",$JOB,"PRV",22222,0,"AFTER")=AFTER0

 +12       SET ^TMP("PXK",$JOB,"PRV",22222,0,"BEFORE")=$GET(^AUPNVPRV($ORDER(PXBSKY(1,0)),0))

 +13       SET ^TMP("PXK",$JOB,"PRV",22222,"IEN")=$ORDER(PXBSKY(1,0))

 +14       DO EN1^PXKMAIN

 +15       KILL PXRDR

 +16       KILL ^TMP("PXBGPOVMATCH",$JOB)

 +17       QUIT

 +18      ;

SPOVPRIM(PXADATA,VISITIEN,PXAERR) ;If there is an exisiting primary diagnosis

 +1       ;change it to secondary so the new primary can be set.

 +2        NEW DIAG,IND,PDNEW

 +3        SET IND=0

           SET PDNEW=""

 +4        FOR

               SET IND=+$ORDER(@PXADATA@("DX/PL",IND))

               if IND=0

                   QUIT

               Begin DoDot:1

 +5                SET DIAG=$GET(@PXADATA@("DX/PL",IND,"DIAGNOSIS"))

 +6                IF DIAG=""

                       QUIT

 +7                IF $GET(@PXADATA@("DX/PL",IND,"PRIMARY"))=1

                       SET PDNEW=DIAG

               End DoDot:1

 +8        IF PDNEW=""

               QUIT

 +9       ;

 +10      ;There is a new primary diagnosis, set any existing primary to

 +11      ;secondary.

 +12       NEW FDA,IENS,MSG

 +13       SET IND=0

 +14       FOR

               SET IND=$ORDER(^AUPNVPOV("AD",VISITIEN,IND))

               if IND=""

                   QUIT

               Begin DoDot:1

 +15               IF $PIECE(^AUPNVPOV(IND,0),U,12)="P"

                       Begin DoDot:2

 +16                       SET IENS=IND_","

 +17                       SET FDA(9000010.07,IENS,.12)="S"

 +18                       DO FILE^DIE("","FDA","MSG")

 +19                       IF $DATA(MSG)

                               Begin DoDot:3

 +20                               SET PXAERR(9)="V POV PRIMARY DIAGNOSIS CHANGE"

 +21                               SET PXAERR(12)=MSG("DIERR",1,"TEXT",1)

 +22                               SET PXAERR(13)="IENS="_IENS

 +23                               DO ERRSET^PXAIPOVV

                               End DoDot:3

                               QUIT

                       End DoDot:2

               End DoDot:1

 +24       QUIT

 +25      ;

PXAIPOV.m