Routine: PXICLN27

PXICLN27 ;ISL/dee - Cleanup providers, routine for PX*1.0*27 ;3/26/97

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**27**;Aug 12, 1996

ENV N PXIPRVLR,PXIPC1,PXIPC2,PXACTIVE,PXIPAT9

 S PXIPAT9=$P($G(^PX(815,1,"PATCH")),"^",1)

 I $O(^AUPNVSIT(PXIPAT9),-1)>0!'(+PXIPAT9) D

 . S XPDABORT=2

 . W !!,"It looks like the cleanup routine in PCE patch PX*1.0*9 did not finish."

 . W !,"The cleanup in patch 9 needs to be restarted so that it can finish."

 . W !,"To restart, enter D QUE^PXICLN9 from the programmers prompt."

 S PXIPRVLR=+$G(^LAB(69.9,1,12))

 I PXIPRVLR<1 D  Q

 . S XPDABORT=2

 . W !!,"The default Lab provider that was added in Lab patch LR*5.2*158"

 . W !,"has not been set up.  This provider must be setup before installing"

 . W !,"this patch."

 S PXIPC1=$$GET^XUA4A72(+PXIPRVLR,DT)

 S PXIPC2=$$GET^XUA4A72(+PXIPRVLR,2961001)

 S PXACTIVE=$P(^VA(200,+PXIPRVLR,0),"^",11)

 I PXIPC1<1!(PXIPC2<1)!(PXACTIVE'="") D

 . S XPDABORT=2

 . W !!,"The default Lab provider that was added in Lab patch LR*5.2*158"

 . W !,"is not a valid provider.  Either they have been terminated or"

 . W !,"they do not have a valid person class from 10/1/96 through now."

QUE ; Queue job to cleanup Lab Providers.

 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE,ZTCPU,ZTUCI

 D BMES^XPDUTL("Job to cleanup Lab and other Providers.")

 S ZTRTN="TASKED^PXICLN27"

 S ZTIO=""

 S ZTDESC="PX*1.0*27 tasked cleanup job"

 S ZTDTH=$H

 S ZTSAVE("DUZ")=DUZ,ZTSAVE("DUZ(")=""

 D ^%ZTLOAD

 I $D(ZTSK) D MES^XPDUTL("The job is task # "_ZTSK)

 I '$D(ZTSK) D MES^XPDUTL("Could not start the task job.") D BMES^XPDUTL("You should start it by doing:  D QUE^PXICLN27  at the programmers prompt.")

TASKED ;

 D CLEANUP

 D MAIL

MAIL ;Send mail messge that job is done.

 N XMY,XMSUB,PXTEXT,XMTEXT

 S XMY(DUZ)=""

 ;S XMY("G.PCEINSTAL@ISC-SLC.DOMAIN.EXT")=""

 S XMSUB="PX*1.0*27 Cleanup is finished"

 S PXTEXT(1)="PX*1.0*27 job to cleanup Lab Providers is done."

 S:$D(ZTQUEUED) PXTEXT(2)="The task job number "_ZTQUEUED_" is finished."

 S PXTEXT(3)=" "

 S PXTEXT(4)="Visit ID for this site is:  "_$P($G(^VSIT(150.2,+$P($G(^DIC(150.9,1,4)),"^",2),0)),"^",2)

 S XMTEXT="PXTEXT("

 D ^XMD

REPORT ;Send mail messge of what was done.

 N XMY,XMSUB,XMTEXT

 S XMY(DUZ)=""

 S PXIPART=PXIPART+1

 S XMSUB="PX*1.0*27 Cleanup Results Part "_PXIPART

 S ^TMP("PXTEXT",$J,1)="PX*1.0*27 job to cleanup Lab Providers."

 S:$D(ZTQUEUED) ^TMP("PXTEXT",$J,2)="The task job number "_ZTQUEUED

 S ^TMP("PXTEXT",$J,3)=" "

 S ^TMP("PXTEXT",$J,4)="IEN      Patient           Encounter Date/Time"

 S ^TMP("PXTEXT",$J,5)="  Provider      What was done or found."

 S ^TMP("PXTEXT",$J,6)=" "

 S ^TMP("PXTEXT",$J,7)="   * in front of the IEN means was not able to cleanup."

 S ^TMP("PXTEXT",$J,8)=" "

 S XMTEXT="^TMP(""PXTEXT"",$J,"

 D ^XMD

 K ^TMP("PXTEXT",$J)

CLEANUP ;

 N PXIVSIT,PXIVSTDT,PXIPRV,PXICOUNT

 N PXISORLR,PXIPKGLR,PXIPRVLR,PXILRNAM

 N PXISORPX,PXIPKGPX,PXIPC

 N PXACTIVE,PXIPRV0,PXI,PXISOR,PXIPKG

 N PXIFDA,PXIDIERR,PXICPT,PXICPTC

 N PXIMSG,PXIVSIT0,PXIPART

 ;Set up report mail message

 S PXIPART=0

 S PXIMSG=8

 K ^TMP("PXTEXT",$J)

 ;Set up package and source for PCE and Lab

 ;S PXISORLR=$$SOURCE^PXAPIUTL("LAB DATA")

 S PXIPKGLR=$$PKG2IEN^VSIT("LR")

 S PXISORPX=$$SOURCE^PXAPIUTL("CLEANUP IN PCE PATCH 27")

 S PXIPKGPX=$$PKG2IEN^VSIT("PX")

 ;get Provider for lab data

 S PXIPRVLR=+$G(^LAB(69.9,1,12))

 S PXILRNAM=$P($G(^VA(200,+PXIPRVLR,0)),"^",1)

 ;Where to start?

 S PXIVSTDT=$P($G(^PX(815,1,"PATCH")),"^",2)

 ;*R "Visit ien: ",PXIVSIT ;*

 ;*S PXIVSTDT=+^AUPNVSIT(PXIVSIT,0)

 ;*D  ;*

 ;*.D  ;*

 F  S PXIVSTDT=$O(^AUPNVSIT("B",PXIVSTDT),-1) Q:'PXIVSTDT!(PXIVSTDT<2961001)  D

 . S PXIVSIT=0

 . F  S PXIVSIT=$O(^AUPNVSIT("B",PXIVSTDT,PXIVSIT)) Q:'PXIVSIT  D

 .. K PXISOR,PXIPKG,PXI

 .. S PXICOUNT=0

 .. S PXIPRV=0

 .. F  S PXIPRV=$O(^AUPNVPRV("AD",PXIVSIT,PXIPRV)) Q:'PXIPRV  D

 ... S PXIPRV0=$G(^AUPNVPRV(PXIPRV,0))

 ... S PXIPC=$$GET^XUA4A72(+PXIPRV0,PXIVSTDT)

 ... S PXACTIVE=$P(^VA(200,+PXIPRV0,0),"^",11)

 ... I $P($G(^AUPNVPRV(PXIPRV,812)),"^",2)=PXIPKGLR D

 .... ;Lab

 .... I $P(PXIPRV0,"^",6)>0,(PXACTIVE=""!(PXACTIVE>PXIVSTDT)) Q  ;this one is ok

 .... I +PXIPC>0,'$P(PXIPRV0,"^",6),(PXACTIVE=""!(PXACTIVE>PXIVSTDT)) D

 ..... ;This one need the Person class added

 ..... S PXICOUNT=PXICOUNT+1

 ..... S PXI("PROVIDER",PXICOUNT,"NAME")=$P(PXIPRV0,"^",1)

 ..... S PXIVSIT0=$G(^AUPNVSIT(PXIVSIT,0))

 ..... S PXIMSG=PXIMSG+1

 ..... S ^TMP("PXTEXT",$J,PXIMSG)=PXIVSIT_"    "_$P($G(^DPT($P(PXIVSIT0,"^",5),0)),"^")_"    "_$$FDTTM^VALM1(+PXIVSIT0)

 ..... S PXIMSG=PXIMSG+1

 ..... S ^TMP("PXTEXT",$J,PXIMSG)="  "_$P($G(^VA(200,+PXIPRV0,0)),"^",1)_"    "_"Added person class"

 ..... I '$D(PXIPKG) D

 ...... S PXIPKG=$P($G(^AUPNVPRV(+PXIPRV,812)),"^",2)

 ...... S PXISOR=$P($G(^AUPNVPRV(+PXIPRV,812)),"^",3)

 .... E  D

 ..... ;This one needs replaced.

 ..... ;Delete this one

 ..... S PXICOUNT=PXICOUNT+1

 ..... S PXI("PROVIDER",PXICOUNT,"NAME")=$P(PXIPRV0,"^",1)

 ..... S PXI("PROVIDER",PXICOUNT,"DELETE")=1

 ..... ;Add default one

 ..... S PXICOUNT=PXICOUNT+1

 ..... S PXI("PROVIDER",PXICOUNT,"NAME")=PXIPRVLR

 ..... S PXI("PROVIDER",PXICOUNT,"PRIMARY")=1

 ..... S PXIVSIT0=$G(^AUPNVSIT(PXIVSIT,0))

 ..... S PXIMSG=PXIMSG+1

 ..... S ^TMP("PXTEXT",$J,PXIMSG)=PXIVSIT_"    "_$P($G(^DPT($P(PXIVSIT0,"^",5),0)),"^")_"    "_$$FDTTM^VALM1(+PXIVSIT0)

 ..... S PXIMSG=PXIMSG+1

 ..... S ^TMP("PXTEXT",$J,PXIMSG)="  Change Provider "_$P($G(^VA(200,+PXIPRV0,0)),"^",1)_"    to Provider "_PXILRNAM

 ..... I '$D(PXIPKG) D

 ...... S PXIPKG=$P($G(^AUPNVPRV(+PXIPRV,812)),"^",2)

 ...... S PXISOR=$P($G(^AUPNVPRV(+PXIPRV,812)),"^",3)

 ..... ;Fix all V CPT that have this as the encounter provider

 ..... S PXICPT=0

 ..... F  S PXICPT=$O(^AUPNVCPT("AD",PXIVSIT,PXICPT)) Q:'PXICPT  D

 ...... I $P($G(^AUPNVCPT(PXICPT,12)),"^",4)=+PXIPRV0 D

 ....... K PXIFDA,PXIDIERR

 ....... S PXICPTC=PXICPT_","

 ....... S PXIFDA(9000010.18,PXICPTC,1204)=PXIPRVLR

 ....... D FILE^DIE("","PXIFDA","PXIDIERR")

 ... E  D

 .... ;not lab

 .... I '$P(PXIPRV0,"^",6) D

 ..... I +PXIPC>0 D

 ...... ;Need to add Person Class

 ...... S PXICOUNT=PXICOUNT+1

 ...... S PXI("PROVIDER",PXICOUNT,"NAME")=$P(PXIPRV0,"^",1)

 ...... S PXIVSIT0=$G(^AUPNVSIT(PXIVSIT,0))

 ...... S PXIMSG=PXIMSG+1

 ...... S ^TMP("PXTEXT",$J,PXIMSG)=PXIVSIT_"    "_$P($G(^DPT($P(PXIVSIT0,"^",5),0)),"^")_"    "_$$FDTTM^VALM1(+PXIVSIT0)

 ...... S PXIMSG=PXIMSG+1

 ...... S ^TMP("PXTEXT",$J,PXIMSG)="  "_$P($G(^VA(200,+PXIPRV0,0)),"^",1)_"    "_"Added person class"

 ...... I '$D(PXIPKG) D

 ....... S PXIPKG=$P($G(^AUPNVPRV(+PXIPRV,812)),"^",2)

 ....... S PXISOR=$P($G(^AUPNVPRV(+PXIPRV,812)),"^",3)

 ..... E  D

 ...... ;Needs Person Class but none to add

 ...... S PXIVSIT0=$G(^AUPNVSIT(PXIVSIT,0))

 ...... S PXIMSG=PXIMSG+1

 ...... S ^TMP("PXTEXT",$J,PXIMSG)="*"_PXIVSIT_"    "_$P($G(^DPT($P(PXIVSIT0,"^",5),0)),"^")_"    "_$$FDTTM^VALM1(+PXIVSIT0)

 ...... S PXIMSG=PXIMSG+1

 ...... S ^TMP("PXTEXT",$J,PXIMSG)="  "_$P($G(^VA(200,+PXIPRV0,0)),"^",1)_"    "_"STILL NEEDS A PERSON CLASS"

 .. ;

 .. I $D(PXI) D

 ... ;Process

 ... I $G(PXIPKG)<1 S PXIPKG=PXIPKGPX

 ... I $G(PXISOR)<1 S PXISOR=PXISORPX

 ... I $$DATA2PCE^PXAPI("PXI",PXIPKG,PXISOR,PXIVSIT)

 .. I PXIMSG>2000 D REPORT S PXIMSG=8

. ;

 . S $P(^PX(815,1,"PATCH"),"^",2)=PXIVSTDT

 I PXIMSG>8 D REPORT

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXICLN27   7443     printed  Mar 13, 2025@21:33:42                                                                                                                                                                                                    Page 2

PXICLN27  ;ISL/dee - Cleanup providers, routine for PX*1.0*27 ;3/26/97

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**27**;Aug 12, 1996

ENV        NEW PXIPRVLR,PXIPC1,PXIPC2,PXACTIVE,PXIPAT9

 +1        SET PXIPAT9=$PIECE($GET(^PX(815,1,"PATCH")),"^",1)

 +2        IF $ORDER(^AUPNVSIT(PXIPAT9),-1)>0!'(+PXIPAT9)

               Begin DoDot:1

 +3                SET XPDABORT=2

 +4                WRITE !!,"It looks like the cleanup routine in PCE patch PX*1.0*9 did not finish."

 +5                WRITE !,"The cleanup in patch 9 needs to be restarted so that it can finish."

 +6                WRITE !,"To restart, enter D QUE^PXICLN9 from the programmers prompt."

               End DoDot:1

 +7        SET PXIPRVLR=+$GET(^LAB(69.9,1,12))

 +8        IF PXIPRVLR<1

               Begin DoDot:1

 +9                SET XPDABORT=2

 +10               WRITE !!,"The default Lab provider that was added in Lab patch LR*5.2*158"

 +11               WRITE !,"has not been set up.  This provider must be setup before installing"

 +12               WRITE !,"this patch."

               End DoDot:1

               QUIT

 +13       SET PXIPC1=$$GET^XUA4A72(+PXIPRVLR,DT)

 +14       SET PXIPC2=$$GET^XUA4A72(+PXIPRVLR,2961001)

 +15       SET PXACTIVE=$PIECE(^VA(200,+PXIPRVLR,0),"^",11)

 +16       IF PXIPC1<1!(PXIPC2<1)!(PXACTIVE'="")

               Begin DoDot:1

 +17               SET XPDABORT=2

 +18               WRITE !!,"The default Lab provider that was added in Lab patch LR*5.2*158"

 +19               WRITE !,"is not a valid provider.  Either they have been terminated or"

 +20               WRITE !,"they do not have a valid person class from 10/1/96 through now."

               End DoDot:1

 +21       QUIT

 +22      ;

QUE       ; Queue job to cleanup Lab Providers.

 +1        NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK,ZTSAVE,ZTCPU,ZTUCI

 +2        DO BMES^XPDUTL("Job to cleanup Lab and other Providers.")

 +3        SET ZTRTN="TASKED^PXICLN27"

 +4        SET ZTIO=""

 +5        SET ZTDESC="PX*1.0*27 tasked cleanup job"

 +6        SET ZTDTH=$HOROLOG

 +7        SET ZTSAVE("DUZ")=DUZ

           SET ZTSAVE("DUZ(")=""

 +8        DO ^%ZTLOAD

 +9        IF $DATA(ZTSK)

               DO MES^XPDUTL("The job is task # "_ZTSK)

 +10       IF '$DATA(ZTSK)

               DO MES^XPDUTL("Could not start the task job.")

               DO BMES^XPDUTL("You should start it by doing:  D QUE^PXICLN27  at the programmers prompt.")

 +11       QUIT

 +12      ;

TASKED    ;

 +1        DO CLEANUP

 +2        DO MAIL

 +3        QUIT

 +4       ;

MAIL      ;Send mail messge that job is done.

 +1        NEW XMY,XMSUB,PXTEXT,XMTEXT

 +2        SET XMY(DUZ)=""

 +3       ;S XMY("G.PCEINSTAL@ISC-SLC.DOMAIN.EXT")=""

 +4        SET XMSUB="PX*1.0*27 Cleanup is finished"

 +5        SET PXTEXT(1)="PX*1.0*27 job to cleanup Lab Providers is done."

 +6        if $DATA(ZTQUEUED)

               SET PXTEXT(2)="The task job number "_ZTQUEUED_" is finished."

 +7        SET PXTEXT(3)=" "

 +8        SET PXTEXT(4)="Visit ID for this site is:  "_$PIECE($GET(^VSIT(150.2,+$PIECE($GET(^DIC(150.9,1,4)),"^",2),0)),"^",2)

 +9        SET XMTEXT="PXTEXT("

 +10       DO ^XMD

 +11       QUIT

 +12      ;

REPORT    ;Send mail messge of what was done.

 +1        NEW XMY,XMSUB,XMTEXT

 +2        SET XMY(DUZ)=""

 +3        SET PXIPART=PXIPART+1

 +4        SET XMSUB="PX*1.0*27 Cleanup Results Part "_PXIPART

 +5        SET ^TMP("PXTEXT",$JOB,1)="PX*1.0*27 job to cleanup Lab Providers."

 +6        if $DATA(ZTQUEUED)

               SET ^TMP("PXTEXT",$JOB,2)="The task job number "_ZTQUEUED

 +7        SET ^TMP("PXTEXT",$JOB,3)=" "

 +8        SET ^TMP("PXTEXT",$JOB,4)="IEN      Patient           Encounter Date/Time"

 +9        SET ^TMP("PXTEXT",$JOB,5)="  Provider      What was done or found."

 +10       SET ^TMP("PXTEXT",$JOB,6)=" "

 +11       SET ^TMP("PXTEXT",$JOB,7)="   * in front of the IEN means was not able to cleanup."

 +12       SET ^TMP("PXTEXT",$JOB,8)=" "

 +13       SET XMTEXT="^TMP(""PXTEXT"",$J,"

 +14       DO ^XMD

 +15       KILL ^TMP("PXTEXT",$JOB)

 +16       QUIT

 +17      ;

CLEANUP   ;

 +1        NEW PXIVSIT,PXIVSTDT,PXIPRV,PXICOUNT

 +2        NEW PXISORLR,PXIPKGLR,PXIPRVLR,PXILRNAM

 +3        NEW PXISORPX,PXIPKGPX,PXIPC

 +4        NEW PXACTIVE,PXIPRV0,PXI,PXISOR,PXIPKG

 +5        NEW PXIFDA,PXIDIERR,PXICPT,PXICPTC

 +6        NEW PXIMSG,PXIVSIT0,PXIPART

 +7       ;

 +8       ;Set up report mail message

 +9        SET PXIPART=0

 +10       SET PXIMSG=8

 +11       KILL ^TMP("PXTEXT",$JOB)

 +12      ;

 +13      ;Set up package and source for PCE and Lab

 +14      ;S PXISORLR=$$SOURCE^PXAPIUTL("LAB DATA")

 +15       SET PXIPKGLR=$$PKG2IEN^VSIT("LR")

 +16       SET PXISORPX=$$SOURCE^PXAPIUTL("CLEANUP IN PCE PATCH 27")

 +17       SET PXIPKGPX=$$PKG2IEN^VSIT("PX")

 +18      ;

 +19      ;get Provider for lab data

 +20       SET PXIPRVLR=+$GET(^LAB(69.9,1,12))

 +21       SET PXILRNAM=$PIECE($GET(^VA(200,+PXIPRVLR,0)),"^",1)

 +22      ;

 +23      ;Where to start?

 +24       SET PXIVSTDT=$PIECE($GET(^PX(815,1,"PATCH")),"^",2)

 +25      ;

 +26      ;*R "Visit ien: ",PXIVSIT ;*

 +27      ;*S PXIVSTDT=+^AUPNVSIT(PXIVSIT,0)

 +28      ;*D  ;*

 +29      ;*.D  ;*

 +30       FOR

               SET PXIVSTDT=$ORDER(^AUPNVSIT("B",PXIVSTDT),-1)

               if 'PXIVSTDT!(PXIVSTDT<2961001)

                   QUIT

               Begin DoDot:1

 +31               SET PXIVSIT=0

 +32               FOR

                       SET PXIVSIT=$ORDER(^AUPNVSIT("B",PXIVSTDT,PXIVSIT))

                       if 'PXIVSIT

                           QUIT

                       Begin DoDot:2

 +33                       KILL PXISOR,PXIPKG,PXI

 +34                       SET PXICOUNT=0

 +35                       SET PXIPRV=0

 +36                       FOR

                               SET PXIPRV=$ORDER(^AUPNVPRV("AD",PXIVSIT,PXIPRV))

                               if 'PXIPRV

                                   QUIT

                               Begin DoDot:3

 +37                               SET PXIPRV0=$GET(^AUPNVPRV(PXIPRV,0))

 +38                               SET PXIPC=$$GET^XUA4A72(+PXIPRV0,PXIVSTDT)

 +39                               SET PXACTIVE=$PIECE(^VA(200,+PXIPRV0,0),"^",11)

 +40                               IF $PIECE($GET(^AUPNVPRV(PXIPRV,812)),"^",2)=PXIPKGLR

                                       Begin DoDot:4

 +41      ;Lab

 +42      ;this one is ok

                                           IF $PIECE(PXIPRV0,"^",6)>0

                                               IF (PXACTIVE=""!(PXACTIVE>PXIVSTDT))

                                                   QUIT

 +43                                       IF +PXIPC>0

                                               IF '$PIECE(PXIPRV0,"^",6)

                                                   IF (PXACTIVE=""!(PXACTIVE>PXIVSTDT))

                                                       Begin DoDot:5

 +44      ;This one need the Person class added

 +45                                                       SET PXICOUNT=PXICOUNT+1

 +46                                                       SET PXI("PROVIDER",PXICOUNT,"NAME")=$PIECE(PXIPRV0,"^",1)

 +47                                                       SET PXIVSIT0=$GET(^AUPNVSIT(PXIVSIT,0))

 +48                                                       SET PXIMSG=PXIMSG+1

 +49                                                       SET ^TMP("PXTEXT",$JOB,PXIMSG)=PXIVSIT_"    "_$PIECE($GET(^DPT($PIECE(PXIVSIT0,"^",5),0)),"^")_"    "_$$FDTTM^VALM1(+PXIVSIT0)

 +50                                                       SET PXIMSG=PXIMSG+1

 +51                                                       SET ^TMP("PXTEXT",$JOB,PXIMSG)="  "_$PIECE($GET(^VA(200,+PXIPRV0,0)),"^",1)_"    "_"Added person class"

 +52                                                       IF '$DATA(PXIPKG)

                                                               Begin DoDot:6

 +53                                                               SET PXIPKG=$PIECE($GET(^AUPNVPRV(+PXIPRV,812)),"^",2)

 +54                                                               SET PXISOR=$PIECE($GET(^AUPNVPRV(+PXIPRV,812)),"^",3)

                                                               End DoDot:6

                                                       End DoDot:5

 +55                                      IF '$TEST

                                               Begin DoDot:5

 +56      ;This one needs replaced.

 +57      ;Delete this one

 +58                                               SET PXICOUNT=PXICOUNT+1

 +59                                               SET PXI("PROVIDER",PXICOUNT,"NAME")=$PIECE(PXIPRV0,"^",1)

 +60                                               SET PXI("PROVIDER",PXICOUNT,"DELETE")=1

 +61      ;Add default one

 +62                                               SET PXICOUNT=PXICOUNT+1

 +63                                               SET PXI("PROVIDER",PXICOUNT,"NAME")=PXIPRVLR

 +64                                               SET PXI("PROVIDER",PXICOUNT,"PRIMARY")=1

 +65                                               SET PXIVSIT0=$GET(^AUPNVSIT(PXIVSIT,0))

 +66                                               SET PXIMSG=PXIMSG+1

 +67                                               SET ^TMP("PXTEXT",$JOB,PXIMSG)=PXIVSIT_"    "_$PIECE($GET(^DPT($PIECE(PXIVSIT0,"^",5),0)),"^")_"    "_$$FDTTM^VALM1(+PXIVSIT0)

 +68                                               SET PXIMSG=PXIMSG+1

 +69                                               SET ^TMP("PXTEXT",$JOB,PXIMSG)="  Change Provider "_$PIECE($GET(^VA(200,+PXIPRV0,0)),"^",1)_"    to Provider "_PXILRNAM

 +70                                               IF '$DATA(PXIPKG)

                                                       Begin DoDot:6

 +71                                                       SET PXIPKG=$PIECE($GET(^AUPNVPRV(+PXIPRV,812)),"^",2)

 +72                                                       SET PXISOR=$PIECE($GET(^AUPNVPRV(+PXIPRV,812)),"^",3)

                                                       End DoDot:6

 +73      ;Fix all V CPT that have this as the encounter provider

 +74                                               SET PXICPT=0

 +75                                               FOR

                                                       SET PXICPT=$ORDER(^AUPNVCPT("AD",PXIVSIT,PXICPT))

                                                       if 'PXICPT

                                                           QUIT

                                                       Begin DoDot:6

 +76                                                       IF $PIECE($GET(^AUPNVCPT(PXICPT,12)),"^",4)=+PXIPRV0

                                                               Begin DoDot:7

 +77                                                               KILL PXIFDA,PXIDIERR

 +78                                                               SET PXICPTC=PXICPT_","

 +79                                                               SET PXIFDA(9000010.18,PXICPTC,1204)=PXIPRVLR

 +80                                                               DO FILE^DIE("","PXIFDA","PXIDIERR")

                                                               End DoDot:7

                                                       End DoDot:6

                                               End DoDot:5

                                       End DoDot:4

 +81                              IF '$TEST

                                       Begin DoDot:4

 +82      ;not lab

 +83                                       IF '$PIECE(PXIPRV0,"^",6)

                                               Begin DoDot:5

 +84                                               IF +PXIPC>0

                                                       Begin DoDot:6

 +85      ;Need to add Person Class

 +86                                                       SET PXICOUNT=PXICOUNT+1

 +87                                                       SET PXI("PROVIDER",PXICOUNT,"NAME")=$PIECE(PXIPRV0,"^",1)

 +88                                                       SET PXIVSIT0=$GET(^AUPNVSIT(PXIVSIT,0))

 +89                                                       SET PXIMSG=PXIMSG+1

 +90                                                       SET ^TMP("PXTEXT",$JOB,PXIMSG)=PXIVSIT_"    "_$PIECE($GET(^DPT($PIECE(PXIVSIT0,"^",5),0)),"^")_"    "_$$FDTTM^VALM1(+PXIVSIT0)

 +91                                                       SET PXIMSG=PXIMSG+1

 +92                                                       SET ^TMP("PXTEXT",$JOB,PXIMSG)="  "_$PIECE($GET(^VA(200,+PXIPRV0,0)),"^",1)_"    "_"Added person class"

 +93                                                       IF '$DATA(PXIPKG)

                                                               Begin DoDot:7

 +94                                                               SET PXIPKG=$PIECE($GET(^AUPNVPRV(+PXIPRV,812)),"^",2)

 +95                                                               SET PXISOR=$PIECE($GET(^AUPNVPRV(+PXIPRV,812)),"^",3)

                                                               End DoDot:7

                                                       End DoDot:6

 +96                                              IF '$TEST

                                                       Begin DoDot:6

 +97      ;Needs Person Class but none to add

 +98                                                       SET PXIVSIT0=$GET(^AUPNVSIT(PXIVSIT,0))

 +99                                                       SET PXIMSG=PXIMSG+1

 +100                                                      SET ^TMP("PXTEXT",$JOB,PXIMSG)="*"_PXIVSIT_"    "_$PIECE($GET(^DPT($PIECE(PXIVSIT0,"^",5),0)),"^")_"    "_$$FDTTM^VALM1(+PXIVSIT0)

 +101                                                      SET PXIMSG=PXIMSG+1

 +102                                                      SET ^TMP("PXTEXT",$JOB,PXIMSG)="  "_$PIECE($GET(^VA(200,+PXIPRV0,0)),"^",1)_"    "_"STILL NEEDS A PERSON CLASS"

                                                       End DoDot:6

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

 +103     ;

 +104                      IF $DATA(PXI)

                               Begin DoDot:3

 +105     ;Process

 +106                              IF $GET(PXIPKG)<1

                                       SET PXIPKG=PXIPKGPX

 +107                              IF $GET(PXISOR)<1

                                       SET PXISOR=PXISORPX

 +108                              IF $$DATA2PCE^PXAPI("PXI",PXIPKG,PXISOR,PXIVSIT)

                               End DoDot:3

 +109                      IF PXIMSG>2000

                               DO REPORT

                               SET PXIMSG=8

                       End DoDot:2

 +110     ;

 +111              SET $PIECE(^PX(815,1,"PATCH"),"^",2)=PXIVSTDT

               End DoDot:1

 +112      IF PXIMSG>8

               DO REPORT

 +113      QUIT

 +114     ;

PXICLN27.m