Routine: PXICLN17

PXICLN17 ;ISL/JVS - Cleanup routine for PX*1.0*17 ;11/8/96

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

LOCK ;--SAVE FOR LOCKING GLOBALS

QUE ; Queue job to change 90731 to 90746 cpt code.

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

 D BMES^XPDUTL("Job to convert V-CPT file entries.")

 S ZTRTN="TASKED^PXICLN17"

 S ZTIO=""

 S ZTDESC="PX*1.0*17 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.")

TASKED ;

 D MAPPING

 D CLEANUP

 D MAIL

 K PXICOUNT,PXICNT,DA,DIK,DIK(1)

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*17 Cleanup is finished"

 S PXTEXT(1)="PX*1.0*17 job to convert 90731 to 90746 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 PXTEXT(5)=$G(PXICOUNT)_" entries were changed at this site"

 S PXTEXT(6)=$G(PXICNT)_" entries were NOT changed at this site"

 S XMTEXT="PXTEXT("

 D ^XMD

CLEANUP ;---SUBROUTINE TO CLEAN UP CPT'S

 N PXIACTV,PXIVSTDT,PXIEN,PXIVSIT

 ;--GET ACTIVATION DATE

 S PXIEN=0 F  S PXIEN=$O(^SD(409.72,"C",90746,PXIEN)) Q:PXIEN'>0  D

 .I $P($G(^SD(409.72,PXIEN,0)),"^",5)>0 D

 ..S PXIACTV=$P($G(^SD(409.72,PXIEN,0)),"^",1)

 ;--GET ENTRIES IN V-CPT

 S PXICNT=0,PXICOUNT=0

 S PXIEN="" F  S PXIEN=$O(^AUPNVCPT("B",90731,PXIEN),-1) Q:PXIEN'>0  D

 .S PXIVSIT=$P(^AUPNVCPT(PXIEN,0),"^",3)

 .Q:'$D(^AUPNVSIT(PXIVSIT,0))

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

 .I PXIVSTDT'<PXIACTV S PXICOUNT=PXICOUNT+1 D CHANGE

 .I PXIVSTDT'>PXIACTV S PXICNT=PXICNT+1

CHANGE ;

 ; PXIEN=V FILE ENTRY

 ; PXIVSIT=VISIT IEN

 N PXICLN17,PXI0,PXI12,PXI812,PXIPKG,PXISOR,VAR

 S PXI0=$G(^AUPNVCPT(PXIEN,0))

 S PXI12=$G(^AUPNVCPT(PXIEN,12))

 S PXI812=$G(^AUPNVCPT(PXIEN,812))

 S PXIPKG=$S($P($G(PXI812),"^",2)>0:$P($G(PXI812),"^",2),1:$$PKG2IEN^VSIT("PX"))

 S PXISOR=$S($P($G(PXI812),"^",3)>0:$P(^PX(839.7,$P($G(PXI812),"^",3),0),"^",1),1:"PX*1.0*17")

 I $P(PXI12,"^",4)']"" D

 .N FLAG

 .S FLAG=1

 .S $P(PXI12,"^",4)=$O(^VA(200,10))

.;

 .S DIK="^AUPNVCPT(",DA=PXIEN D ^DIK

.;

 .S ^TMP("PXICLN17",$J,"PROCEDURE",1,"PROCEDURE")=$P(PXI0,"^",1)

 .S ^TMP("PXICLN17",$J,"PROCEDURE",1,"QTY")=$P(PXI0,"^",16)

 .S ^TMP("PXICLN17",$J,"PROCEDURE",1,"DIAGNOISIS")=$P(PXI0,"^",5)

 .S ^TMP("PXICLN17",$J,"PROCEDURE",1,"ENC PROVIDER")=$P(PXI12,"^",4)

 .S ^TMP("PXICLN17",$J,"PROCEDURE",1,"EVENT D/T")=$P(PXI12,"^",1)

.;

 .S VAR=$$DATA2PCE^PXAPI("^TMP(""PXICLN17"",$J)",$G(PXIPKG),$G(PXISOR),$G(PXIVSIT),"","")

 .K ^TMP("PXICLN17",$J)

 S ^TMP("PXICLN17",$J,"PROCEDURE",1,"PROCEDURE")=$P(PXI0,"^",1)

 S ^TMP("PXICLN17",$J,"PROCEDURE",1,"QTY")=$P(PXI0,"^",16)

 S ^TMP("PXICLN17",$J,"PROCEDURE",1,"DIAGNOISIS")=$P(PXI0,"^",5)

 S ^TMP("PXICLN17",$J,"PROCEDURE",1,"ENC PROVIDER")=$P(PXI12,"^",4)

 S ^TMP("PXICLN17",$J,"PROCEDURE",1,"EVENT D/T")=$P(PXI12,"^",1)

 S ^TMP("PXICLN17",$J,"PROCEDURE",1,"DELETE")=1

 I $G(FLAG) S ^TMP("PXICLN17",$J,"PROVIDER",3,"NAME")=$P($G(PXI12),"^",4)

 I $G(FLAG) S ^TMP("PXICLN17",$J,"PROVIDER",3,"DELETE")=1

 S ^TMP("PXICLN17",$J,"PROCEDURE",2,"PROCEDURE")=90746

 S ^TMP("PXICLN17",$J,"PROCEDURE",2,"QTY")=$P(PXI0,"^",16)

 S ^TMP("PXICLN17",$J,"PROCEDURE",2,"DIAGNOISIS")=$P(PXI0,"^",5)

 S ^TMP("PXICLN17",$J,"PROCEDURE",2,"ENC PROVIDER")=$P(PXI12,"^",4)

 S ^TMP("PXICLN17",$J,"PROCEDURE",2,"EVENT D/T")=$P(PXI12,"^",1)

 S VAR=$$DATA2PCE^PXAPI("^TMP(""PXICLN17"",$J)",$G(PXIPKG),$G(PXISOR),$G(PXIVSIT),"","")

 K ^TMP("PXICLN17",$J)

MAPPING ;--CLEAN UP DATA MAPPING FILE

 N PXQX,PXQY

 S PXQX=0

 S PXQX=$O(^PXD(811.1,"B","10;AUTTIMM(",PXQX))

 S $P(^PXD(811.1,PXQX,0),"^",5)=0

 S PXQX=$O(^PXD(811.1,"B","90731;ICPT(",PXQX))

 S $P(^PXD(811.1,PXQX,0),"^",5)=0

 ;--REINDEX FILE

 S DIK="^PXD(811.1,",DIK(1)=.05 D ENALL^DIK

 S ^PXD(811.1,84,0)="10;AUTTIMM(^90746;ICPT(^IMM^CPT^1"

 S ^PXD(811.1,85,0)="90746;ICPT(^10;AUTTIMM(^CPT^IMM^1"

 S DIK="^PXD(811.1,",DA=84 D EN^DIK

 S DIK="^PXD(811.1,",DA=85 D EN^DIK

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXICLN17   4323     printed  Mar 13, 2025@21:33:41                                                                                                                                                                                                    Page 2

PXICLN17  ;ISL/JVS - Cleanup routine for PX*1.0*17 ;11/8/96

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

 +2       ;

 +3       ;

LOCK      ;--SAVE FOR LOCKING GLOBALS

 +1       ;

QUE       ; Queue job to change 90731 to 90746 cpt code.

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

 +2        DO BMES^XPDUTL("Job to convert V-CPT file entries.")

 +3        SET ZTRTN="TASKED^PXICLN17"

 +4        SET ZTIO=""

 +5        SET ZTDESC="PX*1.0*17 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.")

 +11       QUIT

 +12      ;

TASKED    ;

 +1        DO MAPPING

 +2        DO CLEANUP

 +3        DO MAIL

 +4        KILL PXICOUNT,PXICNT,DA,DIK,DIK(1)

 +5        QUIT

 +6       ;

MAIL      ;Send mail messge that job is done.

 +1        NEW XMY,XMSUB,PXTEXT,XMTEXT

 +2        SET XMY(DUZ)=""

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

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

 +5        SET PXTEXT(1)="PX*1.0*17 job to convert 90731 to 90746 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 PXTEXT(5)=$GET(PXICOUNT)_" entries were changed at this site"

 +10       SET PXTEXT(6)=$GET(PXICNT)_" entries were NOT changed at this site"

 +11       SET XMTEXT="PXTEXT("

 +12       DO ^XMD

 +13       QUIT

 +14      ;

CLEANUP   ;---SUBROUTINE TO CLEAN UP CPT'S

 +1        NEW PXIACTV,PXIVSTDT,PXIEN,PXIVSIT

 +2       ;--GET ACTIVATION DATE

 +3        SET PXIEN=0

FOR

               SET PXIEN=$ORDER(^SD(409.72,"C",90746,PXIEN))

               if PXIEN'>0

                   QUIT

               Begin DoDot:1

 +4                IF $PIECE($GET(^SD(409.72,PXIEN,0)),"^",5)>0

                       Begin DoDot:2

 +5                        SET PXIACTV=$PIECE($GET(^SD(409.72,PXIEN,0)),"^",1)

                       End DoDot:2

               End DoDot:1

 +6       ;--GET ENTRIES IN V-CPT

 +7        SET PXICNT=0

           SET PXICOUNT=0

 +8        SET PXIEN=""

FOR

               SET PXIEN=$ORDER(^AUPNVCPT("B",90731,PXIEN),-1)

               if PXIEN'>0

                   QUIT

               Begin DoDot:1

 +9                SET PXIVSIT=$PIECE(^AUPNVCPT(PXIEN,0),"^",3)

 +10               if '$DATA(^AUPNVSIT(PXIVSIT,0))

                       QUIT

 +11               SET PXIVSTDT=+$GET(^AUPNVSIT(PXIVSIT,0))

 +12               IF PXIVSTDT'<PXIACTV

                       SET PXICOUNT=PXICOUNT+1

                       DO CHANGE

 +13               IF PXIVSTDT'>PXIACTV

                       SET PXICNT=PXICNT+1

               End DoDot:1

 +14       QUIT

 +15      ;

CHANGE    ;

 +1       ; PXIEN=V FILE ENTRY

 +2       ; PXIVSIT=VISIT IEN

 +3        NEW PXICLN17,PXI0,PXI12,PXI812,PXIPKG,PXISOR,VAR

 +4        SET PXI0=$GET(^AUPNVCPT(PXIEN,0))

 +5        SET PXI12=$GET(^AUPNVCPT(PXIEN,12))

 +6        SET PXI812=$GET(^AUPNVCPT(PXIEN,812))

 +7        SET PXIPKG=$SELECT($PIECE($GET(PXI812),"^",2)>0:$PIECE($GET(PXI812),"^",2),1:$$PKG2IEN^VSIT("PX"))

 +8        SET PXISOR=$SELECT($PIECE($GET(PXI812),"^",3)>0:$PIECE(^PX(839.7,$PIECE($GET(PXI812),"^",3),0),"^",1),1:"PX*1.0*17")

 +9       ;

 +10       IF $PIECE(PXI12,"^",4)']""

               Begin DoDot:1

 +11               NEW FLAG

 +12               SET FLAG=1

 +13               SET $PIECE(PXI12,"^",4)=$ORDER(^VA(200,10))

 +14      ;

 +15               SET DIK="^AUPNVCPT("

                   SET DA=PXIEN

                   DO ^DIK

 +16      ;

 +17               SET ^TMP("PXICLN17",$JOB,"PROCEDURE",1,"PROCEDURE")=$PIECE(PXI0,"^",1)

 +18               SET ^TMP("PXICLN17",$JOB,"PROCEDURE",1,"QTY")=$PIECE(PXI0,"^",16)

 +19               SET ^TMP("PXICLN17",$JOB,"PROCEDURE",1,"DIAGNOISIS")=$PIECE(PXI0,"^",5)

 +20               SET ^TMP("PXICLN17",$JOB,"PROCEDURE",1,"ENC PROVIDER")=$PIECE(PXI12,"^",4)

 +21               SET ^TMP("PXICLN17",$JOB,"PROCEDURE",1,"EVENT D/T")=$PIECE(PXI12,"^",1)

 +22      ;

 +23               SET VAR=$$DATA2PCE^PXAPI("^TMP(""PXICLN17"",$J)",$GET(PXIPKG),$GET(PXISOR),$GET(PXIVSIT),"","")

 +24               KILL ^TMP("PXICLN17",$JOB)

               End DoDot:1

 +25      ;

 +26      ;

 +27       SET ^TMP("PXICLN17",$JOB,"PROCEDURE",1,"PROCEDURE")=$PIECE(PXI0,"^",1)

 +28       SET ^TMP("PXICLN17",$JOB,"PROCEDURE",1,"QTY")=$PIECE(PXI0,"^",16)

 +29       SET ^TMP("PXICLN17",$JOB,"PROCEDURE",1,"DIAGNOISIS")=$PIECE(PXI0,"^",5)

 +30       SET ^TMP("PXICLN17",$JOB,"PROCEDURE",1,"ENC PROVIDER")=$PIECE(PXI12,"^",4)

 +31       SET ^TMP("PXICLN17",$JOB,"PROCEDURE",1,"EVENT D/T")=$PIECE(PXI12,"^",1)

 +32       SET ^TMP("PXICLN17",$JOB,"PROCEDURE",1,"DELETE")=1

 +33      ;

 +34       IF $GET(FLAG)

               SET ^TMP("PXICLN17",$JOB,"PROVIDER",3,"NAME")=$PIECE($GET(PXI12),"^",4)

 +35       IF $GET(FLAG)

               SET ^TMP("PXICLN17",$JOB,"PROVIDER",3,"DELETE")=1

 +36      ;

 +37       SET ^TMP("PXICLN17",$JOB,"PROCEDURE",2,"PROCEDURE")=90746

 +38       SET ^TMP("PXICLN17",$JOB,"PROCEDURE",2,"QTY")=$PIECE(PXI0,"^",16)

 +39       SET ^TMP("PXICLN17",$JOB,"PROCEDURE",2,"DIAGNOISIS")=$PIECE(PXI0,"^",5)

 +40       SET ^TMP("PXICLN17",$JOB,"PROCEDURE",2,"ENC PROVIDER")=$PIECE(PXI12,"^",4)

 +41       SET ^TMP("PXICLN17",$JOB,"PROCEDURE",2,"EVENT D/T")=$PIECE(PXI12,"^",1)

 +42      ;

 +43      ;

 +44       SET VAR=$$DATA2PCE^PXAPI("^TMP(""PXICLN17"",$J)",$GET(PXIPKG),$GET(PXISOR),$GET(PXIVSIT),"","")

 +45      ;

 +46      ;

 +47       KILL ^TMP("PXICLN17",$JOB)

 +48       QUIT

 +49      ;

MAPPING   ;--CLEAN UP DATA MAPPING FILE

 +1        NEW PXQX,PXQY

 +2        SET PXQX=0

 +3        SET PXQX=$ORDER(^PXD(811.1,"B","10;AUTTIMM(",PXQX))

 +4        SET $PIECE(^PXD(811.1,PXQX,0),"^",5)=0

 +5        SET PXQX=$ORDER(^PXD(811.1,"B","90731;ICPT(",PXQX))

 +6        SET $PIECE(^PXD(811.1,PXQX,0),"^",5)=0

 +7       ;--REINDEX FILE

 +8       ;

 +9        SET DIK="^PXD(811.1,"

           SET DIK(1)=.05

           DO ENALL^DIK

 +10      ;

 +11       SET ^PXD(811.1,84,0)="10;AUTTIMM(^90746;ICPT(^IMM^CPT^1"

 +12       SET ^PXD(811.1,85,0)="90746;ICPT(^10;AUTTIMM(^CPT^IMM^1"

 +13       SET DIK="^PXD(811.1,"

           SET DA=84

           DO EN^DIK

 +14       SET DIK="^PXD(811.1,"

           SET DA=85

           DO EN^DIK

 +15       QUIT

PXICLN17.m