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
;
Q
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
;
Q
;
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)
Q
;
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
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAIPOV 6206 printed Apr 09, 2024@21:33:03 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 ;
