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.")
Q
;
TASKED ;
D MAPPING
D CLEANUP
D MAIL
K PXICOUNT,PXICNT,DA,DIK,DIK(1)
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*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
Q
;
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
Q
;
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)
Q
;
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXICLN17 4323 printed Oct 16, 2024@18:29:34 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
