PXVRPC7A ;BPFO/LMT - PCE RPCs for V Immunization - Continued ;06/23/16 11:50
;;1.0;PCE PATIENT CARE ENCOUNTER;**216**;Aug 12, 1996;Build 11
;
;
; Reference to ^DIA(9000010.11 supported by ICR #2602
; Reference to NPI^XUSNPI supported by ICR #4532
;
;
DEM(PXPATARR,DFN) ; get patient demographics data
;
N PXI,VADM
;
S PXPATARR("DFN")=DFN
S PXPATARR("ICN")=""
I '$$IFLOCAL^MPIF001(DFN) S PXPATARR("ICN")=$$GETICN^MPIF001(DFN)
I +PXPATARR("ICN")=-1 S PXPATARR("ICN")=""
;
D DEM^VADPT
S PXPATARR("NAME")=VADM(1)
S PXPATARR("DOB")=+$P($P(VADM(3),U),".")
S PXPATARR("SEX")=$P(VADM(5),U)
S PXPATARR("DATE OF DEATH")=$P($P(VADM(6),U),".")
;
S PXI=0
F S PXI=$O(VADM(11,PXI)) Q:'PXI D
. S PXPATARR("ETHNICITY",PXI,0)=$$PTR2CODE^DGUTL4(+VADM(11,PXI),2,2)_U_$P(VADM(11,PXI),U,2) ;icr 3799
;
S PXI=0
F S PXI=$O(VADM(12,PXI)) Q:'PXI D
. S PXPATARR("RACE",PXI,0)=$$PTR2CODE^DGUTL4(+VADM(12,PXI),1,2)_U_$P(VADM(12,PXI),U,2) ;icr 3799
;
D DEMADD(.PXPATARR,.DFN)
D DEMSUP(.PXPATARR,.DFN)
D DEMOTHER(.PXPATARR,.DFN)
D DEMFAC(.PXPATARR,.DFN)
;
D KVA^VADPT
Q
;
DEMADD(PXPATARR,DFN) ;
;
N PXI,VAPA
;
S VAPA("P")="" ;permanent address
D ADD^VADPT
S PXPATARR("ADDRESS")=""
F PXI=1:1:4 S PXPATARR("ADDRESS")=PXPATARR("ADDRESS")_VAPA(PXI)_U
S PXPATARR("ADDRESS")=PXPATARR("ADDRESS")_$P(VAPA(5),U,2)_U_$P(VAPA(11),U,2)
S PXPATARR("PHONE")=VAPA(8)
;
D KVA^VADPT
Q
;
DEMSUP(PXPATARR,DFN) ;
;
N PXA,PXCNT,PXI,PXTYPE,PXX,VAOA
;
S PXCNT=0
F PXA="",1 D
. K VAOA
. I PXA S VAOA("A")=PXA
. D OAD^VADPT
. I $G(VAOA(9))="" Q
. S PXCNT=PXCNT+1
. S PXTYPE=$S(PXA=1:"ECON",1:"NOK")
. S PXX=""
. F PXI=1:1:4 S PXX=PXX_VAOA(PXI)_U
. S PXX=PXX_$P(VAOA(5),U,2)_U_$P(VAOA(11),U,2)
. S PXPATARR("SUPPORT",PXCNT,0)=PXTYPE_U_VAOA(9)_U_VAOA(10)_U_VAOA(8)_U_PXX
;
D KVA^VADPT
Q
;
DEMOTHER(PXPATARR,DFN) ;
N VAPD
D OPD^VADPT
S PXPATARR("PLACE OF BIRTH")=VAPD(1)_U_$P(VAPD(2),U,2)
S PXPATARR("MOTHER MAIDEN NAME")=VAPD(5)
;
D KVA^VADPT
Q
;
DEMFAC(PXPATARR,DFN) ;
;
N PXAGENCY,PXCNT,PXEARLIESTDT,PXERR,PXFAC,PXFACIEN,PXI,PXTF,PXTFL,PXTRDATE
;
S PXEARLIESTDT=($E(DT,1,3)-1)_$E(DT,4,7) ; 1 year ago
S PXCNT=0
S PXERR=1
I $G(PXPATARR("ICN"))>0 S PXERR=$$QUERYTF^VAFCTFU1($P(PXPATARR("ICN"),"V"),"PXTFL","") ;icr 2990
I $P(PXERR,U)=1 K PXTFL
S PXI=0
F S PXI=$O(PXTFL(PXI)) Q:'PXI D
. S PXTF=$G(PXTFL(PXI))
. S PXFACIEN=$P(PXTF,U,1)
. I 'PXFACIEN Q
. S PXAGENCY=$$GET1^DIQ(4,PXFACIEN_",",95,"I") ;icr 10090
. I PXAGENCY'="V" Q
. S PXTRDATE=$P(PXTF,U,2)
. I PXTRDATE<PXEARLIESTDT Q ;only inlcude last 1 year
. S PXFAC=$$NS^XUAF4(PXFACIEN)
. I $P(PXFAC,U,2)="" Q
. I +$P(PXFAC,U,2)?1(1"776",1"200") Q ;non-VA
. S PXCNT=PXCNT+1
. S PXPATARR("FACILITY",PXCNT,0)=PXFAC
;
Q
;
VIMM(PXVIMMARR,PXVIMM,PXFILE,PXDATE) ; get immunization data
;
N DFN,PXFLD,PXNPI
;
S PXDATE=$G(PXDATE)
I PXFILE=9000010.11,PXDATE'>0 D VIMM^PXPXRM(PXVIMM,.PXVIMMARR)
I PXFILE=9000010.11,PXDATE>0 D VIMMED(.PXVIMMARR,PXVIMM,PXDATE)
I PXFILE=9000080.11 D VIMMDEL(.PXVIMMARR,PXVIMM,PXDATE)
K PXVIMMARR("VALUE")
K PXVIMMARR("REMARKS")
S PXVIMMARR("ID")=PXVIMM_$S(PXFILE=9000080.11:"D",1:"")
S DFN=$S(PXFILE=9000010.11:$P($G(^AUPNVIMM(PXVIMM,0)),U,2),1:$P($G(^AUPDVIMM(PXVIMM,0)),U,2))
S PXVIMMARR("PATIENT")=DFN_U_$P($G(^DPT(+DFN,0)),U,1)
S PXVIMMARR("ADMINISTERED DATE TIME")=$G(PXVIMMARR("EVENT DATE TIME"))
I PXVIMMARR("ADMINISTERED DATE TIME")="" D
. S PXVIMMARR("ADMINISTERED DATE TIME")=$P($G(^AUPNVSIT(+$G(PXVIMMARR("VISIT")),0)),U,1)
K PXVIMMARR("EVENT DATE TIME")
I PXVIMMARR("SERIES")'="" D
. S PXVIMMARR("SERIES")=$$EXTERNAL^DILFD(9000010.11,.04,"",PXVIMMARR("SERIES"))
I PXVIMMARR("REACTION")'="" D
. S PXVIMMARR("REACTION")=$$EXTERNAL^DILFD(9000010.11,.06,"",PXVIMMARR("REACTION"))
I PXVIMMARR("MANUFACTURER") D
. S $P(PXVIMMARR("MANUFACTURER"),U,3)=$P($G(^AUTTIMAN(+PXVIMMARR("MANUFACTURER"),0)),U,2)
F PXFLD="ORDERING PROVIDER","ENCOUNTER PROVIDER","DOCUMENTER" D
. I PXVIMMARR(PXFLD) D
. . S PXNPI=$P($$NPI^XUSNPI("Individual_ID",+PXVIMMARR(PXFLD),DT),U,1) ;ICR 4532
. . I PXNPI'=0,PXNPI'=-1,PXNPI'="" S $P(PXVIMMARR(PXFLD),U,3)=$P(PXNPI,U,1)
. . S $P(PXVIMMARR(PXFLD),U,4)=$$VPID^XUPS(+PXVIMMARR(PXFLD)) ; 4574
S PXVIMMARR("COMPLETION STATUS")="COMPLETE"
S PXVIMMARR("FACILITY")=$P($G(PXVIMMARR("FACILITY")),U,2,3)
Q
;
VIMMDEL(PXVIMMARR,PXVIMM,PXDATE) ;pull record from V Immunization file
;
N PXEDITS,PXFLDLOC,PXFLDNUM,PXNODE,PXPIECE,PXTMP
;
I '$G(PXVIMM) Q
I '$D(^AUPDVIMM(PXVIMM)) Q
S PXDATE=$G(PXDATE)
;
K ^TMP("PXVIMM",$J)
M ^TMP("PXVIMM",$J,PXVIMM)=^AUPDVIMM(PXVIMM)
;
I PXDATE D
. D GETEDITS(.PXEDITS,PXVIMM,PXDATE)
. ; make sure the record in the audits is referring to the same record in the deleted file
. S PXTMP=$G(^TMP("PXVIMM",$J,PXVIMM,0))
. I $P($G(PXEDITS(.01)),U,1)'=$P(PXTMP,U,1) Q
. I $P($G(PXEDITS(.02)),U,1)'=$P(PXTMP,U,2) Q
. I $P($G(PXEDITS(.03)),U,1)'=$P(PXTMP,U,3) Q
. ;
. S PXFLDNUM=0
. F S PXFLDNUM=$O(PXEDITS(PXFLDNUM)) Q:PXFLDNUM'>0 D
. . S PXFLDLOC=$$GET1^DID(9000010.11,PXFLDNUM,"","GLOBAL SUBSCRIPT LOCATION")
. . S PXNODE=$P(PXFLDLOC,";",1)
. . S PXPIECE=+$P(PXFLDLOC,";",2)
. . I (PXNODE="")!('PXPIECE) Q
. . S $P(^TMP("PXVIMM",$J,PXVIMM,PXNODE),U,PXPIECE)=$P(PXEDITS(PXFLDNUM),U,1)
;
D VIMM2^PXPXRM(PXVIMM,.PXVIMMARR)
;
K ^TMP("PXVIMM",$J)
;
Q
;
VIMMED(PXVIMMARR,PXVIMM,PXDATE) ;pull editted record it existed on PXDATE
;
N PXEDITS,PXFLDLOC,PXFLDNUM,PXNODE,PXPIECE
;
I '$G(PXVIMM) Q
I '$D(^AUPNVIMM(PXVIMM)) Q
;
K ^TMP("PXVIMM",$J)
M ^TMP("PXVIMM",$J,PXVIMM)=^AUPNVIMM(PXVIMM)
;
D GETEDITS(.PXEDITS,PXVIMM,PXDATE)
S PXFLDNUM=0
F S PXFLDNUM=$O(PXEDITS(PXFLDNUM)) Q:PXFLDNUM'>0 D
. S PXFLDLOC=$$GET1^DID(9000010.11,PXFLDNUM,"","GLOBAL SUBSCRIPT LOCATION")
. S PXNODE=$P(PXFLDLOC,";",1)
. S PXPIECE=+$P(PXFLDLOC,";",2)
. I (PXNODE="")!('PXPIECE) Q
. S $P(^TMP("PXVIMM",$J,PXVIMM,PXNODE),U,PXPIECE)=$P(PXEDITS(PXFLDNUM),U,1)
;
D VIMM2^PXPXRM(PXVIMM,.PXVIMMARR)
;
K ^TMP("PXVIMM",$J)
;
Q
;
GETEDITS(PXBEFORE,PXVIMM,PXDATE) ;get fields that changed since PXDATE
;
N PXADDDT,PXAUDIEN,PXAUDTMP,PXEDITDT,PXEXTVAL,PXFILE,PXFLDNUM,PXINTVAL,PXLASTEDIT
;
S PXFILE=9000010.11
S PXADDDT=0
S PXAUDIEN=0
F S PXAUDIEN=$O(^DIA(PXFILE,"B",PXVIMM,PXAUDIEN)) Q:('PXAUDIEN)!(PXADDDT>PXDATE) D ; ICR 2602
. S PXAUDTMP=$G(^DIA(PXFILE,PXAUDIEN,0)) ; ICR 2602
. S PXEDITDT=$P(PXAUDTMP,U,2)
. I PXEDITDT<PXDATE Q
. S PXFLDNUM=$P(PXAUDTMP,U,3)
. I PXFLDNUM'>0 Q
. I $P(PXAUDTMP,U,5)="A" S PXADDDT=PXEDITDT
. S PXLASTEDIT=$P($G(PXBEFORE(PXFLDNUM)),U,2)
. I PXLASTEDIT,PXLASTEDIT<PXEDITDT Q ;if it was editted multiple times, get the 1st edit
. S PXINTVAL=$P($G(^DIA(PXFILE,PXAUDIEN,2.1)),U,1) ; ICR 2602
. S PXEXTVAL=$G(^DIA(PXFILE,PXAUDIEN,2)) ; ICR 2602
. I PXINTVAL="",PXEXTVAL'="" D I PXINTVAL=U Q
. . D CHK^DIE(9000010.11,PXFLDNUM,"",PXEXTVAL,.PXINTVAL)
. S PXBEFORE(PXFLDNUM)=PXINTVAL_U_PXEDITDT
;
I PXADDDT>PXDATE K PXBEFORE Q
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVRPC7A 7131 printed Nov 22, 2024@17:42:05 Page 2
PXVRPC7A ;BPFO/LMT - PCE RPCs for V Immunization - Continued ;06/23/16 11:50
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**216**;Aug 12, 1996;Build 11
+2 ;
+3 ;
+4 ; Reference to ^DIA(9000010.11 supported by ICR #2602
+5 ; Reference to NPI^XUSNPI supported by ICR #4532
+6 ;
+7 ;
DEM(PXPATARR,DFN) ; get patient demographics data
+1 ;
+2 NEW PXI,VADM
+3 ;
+4 SET PXPATARR("DFN")=DFN
+5 SET PXPATARR("ICN")=""
+6 IF '$$IFLOCAL^MPIF001(DFN)
SET PXPATARR("ICN")=$$GETICN^MPIF001(DFN)
+7 IF +PXPATARR("ICN")=-1
SET PXPATARR("ICN")=""
+8 ;
+9 DO DEM^VADPT
+10 SET PXPATARR("NAME")=VADM(1)
+11 SET PXPATARR("DOB")=+$PIECE($PIECE(VADM(3),U),".")
+12 SET PXPATARR("SEX")=$PIECE(VADM(5),U)
+13 SET PXPATARR("DATE OF DEATH")=$PIECE($PIECE(VADM(6),U),".")
+14 ;
+15 SET PXI=0
+16 FOR
SET PXI=$ORDER(VADM(11,PXI))
if 'PXI
QUIT
Begin DoDot:1
+17 ;icr 3799
SET PXPATARR("ETHNICITY",PXI,0)=$$PTR2CODE^DGUTL4(+VADM(11,PXI),2,2)_U_$PIECE(VADM(11,PXI),U,2)
End DoDot:1
+18 ;
+19 SET PXI=0
+20 FOR
SET PXI=$ORDER(VADM(12,PXI))
if 'PXI
QUIT
Begin DoDot:1
+21 ;icr 3799
SET PXPATARR("RACE",PXI,0)=$$PTR2CODE^DGUTL4(+VADM(12,PXI),1,2)_U_$PIECE(VADM(12,PXI),U,2)
End DoDot:1
+22 ;
+23 DO DEMADD(.PXPATARR,.DFN)
+24 DO DEMSUP(.PXPATARR,.DFN)
+25 DO DEMOTHER(.PXPATARR,.DFN)
+26 DO DEMFAC(.PXPATARR,.DFN)
+27 ;
+28 DO KVA^VADPT
+29 QUIT
+30 ;
DEMADD(PXPATARR,DFN) ;
+1 ;
+2 NEW PXI,VAPA
+3 ;
+4 ;permanent address
SET VAPA("P")=""
+5 DO ADD^VADPT
+6 SET PXPATARR("ADDRESS")=""
+7 FOR PXI=1:1:4
SET PXPATARR("ADDRESS")=PXPATARR("ADDRESS")_VAPA(PXI)_U
+8 SET PXPATARR("ADDRESS")=PXPATARR("ADDRESS")_$PIECE(VAPA(5),U,2)_U_$PIECE(VAPA(11),U,2)
+9 SET PXPATARR("PHONE")=VAPA(8)
+10 ;
+11 DO KVA^VADPT
+12 QUIT
+13 ;
DEMSUP(PXPATARR,DFN) ;
+1 ;
+2 NEW PXA,PXCNT,PXI,PXTYPE,PXX,VAOA
+3 ;
+4 SET PXCNT=0
+5 FOR PXA="",1
Begin DoDot:1
+6 KILL VAOA
+7 IF PXA
SET VAOA("A")=PXA
+8 DO OAD^VADPT
+9 IF $GET(VAOA(9))=""
QUIT
+10 SET PXCNT=PXCNT+1
+11 SET PXTYPE=$SELECT(PXA=1:"ECON",1:"NOK")
+12 SET PXX=""
+13 FOR PXI=1:1:4
SET PXX=PXX_VAOA(PXI)_U
+14 SET PXX=PXX_$PIECE(VAOA(5),U,2)_U_$PIECE(VAOA(11),U,2)
+15 SET PXPATARR("SUPPORT",PXCNT,0)=PXTYPE_U_VAOA(9)_U_VAOA(10)_U_VAOA(8)_U_PXX
End DoDot:1
+16 ;
+17 DO KVA^VADPT
+18 QUIT
+19 ;
DEMOTHER(PXPATARR,DFN) ;
+1 NEW VAPD
+2 DO OPD^VADPT
+3 SET PXPATARR("PLACE OF BIRTH")=VAPD(1)_U_$PIECE(VAPD(2),U,2)
+4 SET PXPATARR("MOTHER MAIDEN NAME")=VAPD(5)
+5 ;
+6 DO KVA^VADPT
+7 QUIT
+8 ;
DEMFAC(PXPATARR,DFN) ;
+1 ;
+2 NEW PXAGENCY,PXCNT,PXEARLIESTDT,PXERR,PXFAC,PXFACIEN,PXI,PXTF,PXTFL,PXTRDATE
+3 ;
+4 ; 1 year ago
SET PXEARLIESTDT=($EXTRACT(DT,1,3)-1)_$EXTRACT(DT,4,7)
+5 SET PXCNT=0
+6 SET PXERR=1
+7 ;icr 2990
IF $GET(PXPATARR("ICN"))>0
SET PXERR=$$QUERYTF^VAFCTFU1($PIECE(PXPATARR("ICN"),"V"),"PXTFL","")
+8 IF $PIECE(PXERR,U)=1
KILL PXTFL
+9 SET PXI=0
+10 FOR
SET PXI=$ORDER(PXTFL(PXI))
if 'PXI
QUIT
Begin DoDot:1
+11 SET PXTF=$GET(PXTFL(PXI))
+12 SET PXFACIEN=$PIECE(PXTF,U,1)
+13 IF 'PXFACIEN
QUIT
+14 ;icr 10090
SET PXAGENCY=$$GET1^DIQ(4,PXFACIEN_",",95,"I")
+15 IF PXAGENCY'="V"
QUIT
+16 SET PXTRDATE=$PIECE(PXTF,U,2)
+17 ;only inlcude last 1 year
IF PXTRDATE<PXEARLIESTDT
QUIT
+18 SET PXFAC=$$NS^XUAF4(PXFACIEN)
+19 IF $PIECE(PXFAC,U,2)=""
QUIT
+20 ;non-VA
IF +$PIECE(PXFAC,U,2)?1(1"776",1"200")
QUIT
+21 SET PXCNT=PXCNT+1
+22 SET PXPATARR("FACILITY",PXCNT,0)=PXFAC
End DoDot:1
+23 ;
+24 QUIT
+25 ;
VIMM(PXVIMMARR,PXVIMM,PXFILE,PXDATE) ; get immunization data
+1 ;
+2 NEW DFN,PXFLD,PXNPI
+3 ;
+4 SET PXDATE=$GET(PXDATE)
+5 IF PXFILE=9000010.11
IF PXDATE'>0
DO VIMM^PXPXRM(PXVIMM,.PXVIMMARR)
+6 IF PXFILE=9000010.11
IF PXDATE>0
DO VIMMED(.PXVIMMARR,PXVIMM,PXDATE)
+7 IF PXFILE=9000080.11
DO VIMMDEL(.PXVIMMARR,PXVIMM,PXDATE)
+8 KILL PXVIMMARR("VALUE")
+9 KILL PXVIMMARR("REMARKS")
+10 SET PXVIMMARR("ID")=PXVIMM_$SELECT(PXFILE=9000080.11:"D",1:"")
+11 SET DFN=$SELECT(PXFILE=9000010.11:$PIECE($GET(^AUPNVIMM(PXVIMM,0)),U,2),1:$PIECE($GET(^AUPDVIMM(PXVIMM,0)),U,2))
+12 SET PXVIMMARR("PATIENT")=DFN_U_$PIECE($GET(^DPT(+DFN,0)),U,1)
+13 SET PXVIMMARR("ADMINISTERED DATE TIME")=$GET(PXVIMMARR("EVENT DATE TIME"))
+14 IF PXVIMMARR("ADMINISTERED DATE TIME")=""
Begin DoDot:1
+15 SET PXVIMMARR("ADMINISTERED DATE TIME")=$PIECE($GET(^AUPNVSIT(+$GET(PXVIMMARR("VISIT")),0)),U,1)
End DoDot:1
+16 KILL PXVIMMARR("EVENT DATE TIME")
+17 IF PXVIMMARR("SERIES")'=""
Begin DoDot:1
+18 SET PXVIMMARR("SERIES")=$$EXTERNAL^DILFD(9000010.11,.04,"",PXVIMMARR("SERIES"))
End DoDot:1
+19 IF PXVIMMARR("REACTION")'=""
Begin DoDot:1
+20 SET PXVIMMARR("REACTION")=$$EXTERNAL^DILFD(9000010.11,.06,"",PXVIMMARR("REACTION"))
End DoDot:1
+21 IF PXVIMMARR("MANUFACTURER")
Begin DoDot:1
+22 SET $PIECE(PXVIMMARR("MANUFACTURER"),U,3)=$PIECE($GET(^AUTTIMAN(+PXVIMMARR("MANUFACTURER"),0)),U,2)
End DoDot:1
+23 FOR PXFLD="ORDERING PROVIDER","ENCOUNTER PROVIDER","DOCUMENTER"
Begin DoDot:1
+24 IF PXVIMMARR(PXFLD)
Begin DoDot:2
+25 ;ICR 4532
SET PXNPI=$PIECE($$NPI^XUSNPI("Individual_ID",+PXVIMMARR(PXFLD),DT),U,1)
+26 IF PXNPI'=0
IF PXNPI'=-1
IF PXNPI'=""
SET $PIECE(PXVIMMARR(PXFLD),U,3)=$PIECE(PXNPI,U,1)
+27 ; 4574
SET $PIECE(PXVIMMARR(PXFLD),U,4)=$$VPID^XUPS(+PXVIMMARR(PXFLD))
End DoDot:2
End DoDot:1
+28 SET PXVIMMARR("COMPLETION STATUS")="COMPLETE"
+29 SET PXVIMMARR("FACILITY")=$PIECE($GET(PXVIMMARR("FACILITY")),U,2,3)
+30 QUIT
+31 ;
VIMMDEL(PXVIMMARR,PXVIMM,PXDATE) ;pull record from V Immunization file
+1 ;
+2 NEW PXEDITS,PXFLDLOC,PXFLDNUM,PXNODE,PXPIECE,PXTMP
+3 ;
+4 IF '$GET(PXVIMM)
QUIT
+5 IF '$DATA(^AUPDVIMM(PXVIMM))
QUIT
+6 SET PXDATE=$GET(PXDATE)
+7 ;
+8 KILL ^TMP("PXVIMM",$JOB)
+9 MERGE ^TMP("PXVIMM",$JOB,PXVIMM)=^AUPDVIMM(PXVIMM)
+10 ;
+11 IF PXDATE
Begin DoDot:1
+12 DO GETEDITS(.PXEDITS,PXVIMM,PXDATE)
+13 ; make sure the record in the audits is referring to the same record in the deleted file
+14 SET PXTMP=$GET(^TMP("PXVIMM",$JOB,PXVIMM,0))
+15 IF $PIECE($GET(PXEDITS(.01)),U,1)'=$PIECE(PXTMP,U,1)
QUIT
+16 IF $PIECE($GET(PXEDITS(.02)),U,1)'=$PIECE(PXTMP,U,2)
QUIT
+17 IF $PIECE($GET(PXEDITS(.03)),U,1)'=$PIECE(PXTMP,U,3)
QUIT
+18 ;
+19 SET PXFLDNUM=0
+20 FOR
SET PXFLDNUM=$ORDER(PXEDITS(PXFLDNUM))
if PXFLDNUM'>0
QUIT
Begin DoDot:2
+21 SET PXFLDLOC=$$GET1^DID(9000010.11,PXFLDNUM,"","GLOBAL SUBSCRIPT LOCATION")
+22 SET PXNODE=$PIECE(PXFLDLOC,";",1)
+23 SET PXPIECE=+$PIECE(PXFLDLOC,";",2)
+24 IF (PXNODE="")!('PXPIECE)
QUIT
+25 SET $PIECE(^TMP("PXVIMM",$JOB,PXVIMM,PXNODE),U,PXPIECE)=$PIECE(PXEDITS(PXFLDNUM),U,1)
End DoDot:2
End DoDot:1
+26 ;
+27 DO VIMM2^PXPXRM(PXVIMM,.PXVIMMARR)
+28 ;
+29 KILL ^TMP("PXVIMM",$JOB)
+30 ;
+31 QUIT
+32 ;
VIMMED(PXVIMMARR,PXVIMM,PXDATE) ;pull editted record it existed on PXDATE
+1 ;
+2 NEW PXEDITS,PXFLDLOC,PXFLDNUM,PXNODE,PXPIECE
+3 ;
+4 IF '$GET(PXVIMM)
QUIT
+5 IF '$DATA(^AUPNVIMM(PXVIMM))
QUIT
+6 ;
+7 KILL ^TMP("PXVIMM",$JOB)
+8 MERGE ^TMP("PXVIMM",$JOB,PXVIMM)=^AUPNVIMM(PXVIMM)
+9 ;
+10 DO GETEDITS(.PXEDITS,PXVIMM,PXDATE)
+11 SET PXFLDNUM=0
+12 FOR
SET PXFLDNUM=$ORDER(PXEDITS(PXFLDNUM))
if PXFLDNUM'>0
QUIT
Begin DoDot:1
+13 SET PXFLDLOC=$$GET1^DID(9000010.11,PXFLDNUM,"","GLOBAL SUBSCRIPT LOCATION")
+14 SET PXNODE=$PIECE(PXFLDLOC,";",1)
+15 SET PXPIECE=+$PIECE(PXFLDLOC,";",2)
+16 IF (PXNODE="")!('PXPIECE)
QUIT
+17 SET $PIECE(^TMP("PXVIMM",$JOB,PXVIMM,PXNODE),U,PXPIECE)=$PIECE(PXEDITS(PXFLDNUM),U,1)
End DoDot:1
+18 ;
+19 DO VIMM2^PXPXRM(PXVIMM,.PXVIMMARR)
+20 ;
+21 KILL ^TMP("PXVIMM",$JOB)
+22 ;
+23 QUIT
+24 ;
GETEDITS(PXBEFORE,PXVIMM,PXDATE) ;get fields that changed since PXDATE
+1 ;
+2 NEW PXADDDT,PXAUDIEN,PXAUDTMP,PXEDITDT,PXEXTVAL,PXFILE,PXFLDNUM,PXINTVAL,PXLASTEDIT
+3 ;
+4 SET PXFILE=9000010.11
+5 SET PXADDDT=0
+6 SET PXAUDIEN=0
+7 ; ICR 2602
FOR
SET PXAUDIEN=$ORDER(^DIA(PXFILE,"B",PXVIMM,PXAUDIEN))
if ('PXAUDIEN)!(PXADDDT>PXDATE)
QUIT
Begin DoDot:1
+8 ; ICR 2602
SET PXAUDTMP=$GET(^DIA(PXFILE,PXAUDIEN,0))
+9 SET PXEDITDT=$PIECE(PXAUDTMP,U,2)
+10 IF PXEDITDT<PXDATE
QUIT
+11 SET PXFLDNUM=$PIECE(PXAUDTMP,U,3)
+12 IF PXFLDNUM'>0
QUIT
+13 IF $PIECE(PXAUDTMP,U,5)="A"
SET PXADDDT=PXEDITDT
+14 SET PXLASTEDIT=$PIECE($GET(PXBEFORE(PXFLDNUM)),U,2)
+15 ;if it was editted multiple times, get the 1st edit
IF PXLASTEDIT
IF PXLASTEDIT<PXEDITDT
QUIT
+16 ; ICR 2602
SET PXINTVAL=$PIECE($GET(^DIA(PXFILE,PXAUDIEN,2.1)),U,1)
+17 ; ICR 2602
SET PXEXTVAL=$GET(^DIA(PXFILE,PXAUDIEN,2))
+18 IF PXINTVAL=""
IF PXEXTVAL'=""
Begin DoDot:2
+19 DO CHK^DIE(9000010.11,PXFLDNUM,"",PXEXTVAL,.PXINTVAL)
End DoDot:2
IF PXINTVAL=U
QUIT
+20 SET PXBEFORE(PXFLDNUM)=PXINTVAL_U_PXEDITDT
End DoDot:1
+21 ;
+22 IF PXADDDT>PXDATE
KILL PXBEFORE
QUIT
+23 ;
+24 QUIT
