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."
Q
;
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.")
Q
;
TASKED ;
D CLEANUP
D MAIL
Q
;
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
Q
;
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)
Q
;
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
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXICLN27 7443 printed Apr 09, 2024@21:29:14 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 ;
