PXAIPRV ;ISL/JVS,ESW,PKR - SET THE PROVIDER NODES ;08/07/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**5,108,124,211**;Aug 12, 1996;Build 454
;
Q
PRV ;--CREATE PROVIDERS
;
SET ;--SET AND NEW VARIABLES
N AFTER0,AFTER12,AFTER801,AFTER811,AFTER812
N BEFOR0,BEFOR12,BEFOR801,BEFOR811,BEFOR812
N NODE,PXAA,PXAB,SUB,PXAAX,IENB,STOP
;
K PXAERR
S PXAERR(8)=PXAK
S PXAERR(7)="PROVIDER"
;
S SUB="" F S SUB=$O(@PXADATA@("PROVIDER",PXAK,SUB)) Q:SUB="" D
.S PXAA(SUB)=@PXADATA@("PROVIDER",PXAK,SUB)
;
;--VALIDATE ENOUGH DATA
D VAL^PXAIPRVV Q:$G(STOP)
;
SETVARA ;--SET VISIT VARIABLES
S $P(AFTER0,"^",1)=$G(PXAA("NAME"))
I $G(PXAA("DELETE")) S $P(AFTER0,"^",1)="@"
S $P(AFTER0,"^",2)=$G(PATIENT)
S $P(AFTER0,"^",3)=$G(PXAVISIT)
S $P(AFTER0,"^",4)=$S($G(PXAA("PRIMARY"))=1:"P",1:"S")
S $P(AFTER0,"^",5)=$S($G(PXAA("ATTENDING"))=1:"A",$G(PXAA("ATTENDING"))=0:"@",1:"")
S $P(AFTER12,"^",1)=$G(PXAA("EVENT D/T"))
S $P(AFTER811,"^",1)=$G(PXAA("COMMENT"))
S $P(AFTER812,"^",2)=$S($G(PXAA("PKG"))'="":PXAA("PKG"),1:$G(PXAPKG))
S $P(AFTER812,"^",3)=$S($G(PXAA("SOURCE"))'="":PXAA("SOURCE"),1:$G(PXASOURC))
;
SETPXKA ;--SET PXK ARRAY AFTER
S ^TMP("PXK",$J,"PRV",PXAK,0,"AFTER")=AFTER0
S ^TMP("PXK",$J,"PRV",PXAK,12,"AFTER")=AFTER12
S ^TMP("PXK",$J,"PRV",PXAK,811,"AFTER")=AFTER811
S ^TMP("PXK",$J,"PRV",PXAK,812,"AFTER")=AFTER812
;
SETVARB ;--SET VARIABLES BEFORE
;
;--CHECK FOR PRIMARY DESIGNATION
N ITEM,PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI
D PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
;CHECK NAME
S PXAAX("NAME")=$P($G(^VA(200,$G(PXAA("NAME")),0)),"^",1)
;
;--GET IEN FOR 'PXK NODE'
I $G(PXAA("DELETE"))=1 S PXAAX("NAME")=$P($G(^VA(200,PXAA("NAME"),0)),"^",1)
S ITEM="" I PXBCNT>0,$G(PXAAX("NAME"))]"" S ITEM=$O(PXBKY(PXAAX("NAME"),0))
I ITEM]"" S (^TMP("PXK",$J,"PRV",PXAK,"IEN"),IENB)=$O(PXBSKY(ITEM,0))
;
I $G(IENB) D
.F NODE=0,12,811,812 S ^TMP("PXK",$J,"PRV",PXAK,NODE,"BEFORE")=$G(^AUPNVPRV(IENB,NODE))
E D
.S (BEFOR0,BEFOR12,BEFOR811,BEFOR812)=""
.;
SETPXKB .;--SET PXK ARRAY BEFORE
.S ^TMP("PXK",$J,"PRV",PXAK,0,"BEFORE")=BEFOR0
.S ^TMP("PXK",$J,"PRV",PXAK,12,"BEFORE")=BEFOR12
.S ^TMP("PXK",$J,"PRV",PXAK,811,"BEFORE")=BEFOR811
.S ^TMP("PXK",$J,"PRV",PXAK,812,"BEFORE")=BEFOR812
.S ^TMP("PXK",$J,"PRV",PXAK,"IEN")=""
;
;Package and Data Source cannot be edited.
S BEFOR812=^TMP("PXK",$J,"PRV",PXAK,812,"BEFORE")
I BEFOR812'="" D
. I AFTER812=BEFOR812 Q
. I $P(BEFOR812,U,2)'="" S $P(AFTER812,U,2)=$P(BEFOR812,U,2)
. I $P(BEFOR812,U,3)'="" S $P(AFTER812,U,3)=$P(BEFOR812,U,3)
. S ^TMP("PXK",$J,"PRV",PXAK,812,"AFTER")=AFTER812
;
MISC ;--MISCELLANEOUS NODE
;
Q
OTHER ;---ADD OTHER PROVIDERS TO V PROVIDER FOR OTHER ENTRIES
;
; generate data, PXBSKY(), about currently filed providers
;
N PXBSKY
I $G(PXAVISIT) D PRV^PXBGPRV(PXAVISIT,.PXBSKY)
;
N IEN,AFTER0,CNT,PXAK,STOP,FF
S IEN="",CNT=1000
;
;---^TMP("PXAIADDPRV",$J,'IEN')=""
;
F S IEN=$O(^TMP("PXAIADDPRV",$J,IEN)),CNT=CNT+1 Q:IEN="" D
.;
.;verify if an entry for a provider already exists
.;
.S STOP=0
.I $D(^TMP("PXK",$J,"PRV")) S PXAK="" D Q:STOP
..F S PXAK=$O(^TMP("PXK",$J,"PRV",PXAK)) Q:PXAK="" D Q:STOP
...I +$G(^TMP("PXK",$J,"PRV",PXAK,0,"AFTER"))=IEN S STOP=1
.S FF="PXBSKY" F S FF=$Q(@FF) Q:FF="" I @FF=IEN S STOP=1 Q
.Q:STOP
.;
.S $P(AFTER0,"^",1)=IEN
.S $P(AFTER0,"^",2)=$P(^AUPNVSIT(PXAVISIT,0),"^",5)
.S $P(AFTER0,"^",3)=PXAVISIT
.S $P(AFTER0,"^",4)="S"
.S $P(AFTER812,"^",2)=$G(PXAPKG)
.S $P(AFTER812,"^",3)=$G(PXASOURC)
.S ^TMP("PXK",$J,"PRV",CNT,0,"AFTER")=$G(AFTER0)
.S ^TMP("PXK",$J,"PRV",CNT,811,"AFTER")=""
.S ^TMP("PXK",$J,"PRV",CNT,812,"AFTER")=$G(AFTER812)
.S ^TMP("PXK",$J,"PRV",CNT,0,"BEFORE")=""
.S ^TMP("PXK",$J,"PRV",CNT,811,"BEFORE")=""
.S ^TMP("PXK",$J,"PRV",CNT,812,"BEFORE")=""
.S ^TMP("PXK",$J,"PRV",CNT,"IEN")=""
Q
;
PRIM ;--SET A PROVIDER AS PRIMARY
N NPRIM,NPROV,PORS,PRIMARY,PROVIDER,PROVIDERLIST,VPRVIEN
S (NPRIM,NPROV,VPRVIEN)=0
F S VPRVIEN=+$O(^AUPNVPRV("AD",PXAVISIT,VPRVIEN)) Q:VPRVIEN=0 D
. S NPROV=NPROV+1
. S TEMP=^AUPNVPRV(VPRVIEN,0)
. S PROVIDER=$P(TEMP,U,1)
. S PORS=$P(TEMP,U,4)
. S PROVIDERLIST(PROVIDER)=VPRVIEN_U_PORS
. I PORS="P" S NPRIM=NPRIM+1
;If there is a primary provider or no providers quit.
I (NPRIM=1)!(NPROV=0) K ^TMP("PXAIADDPRV",$J) Q
;No primary provider found, first use the encounter provider with
;the lowest DUZ and if there is no encounter provider use the
;ordering provider.
S (PRIMARY,PROVIDER)=""
F S PROVIDER=$O(PROVIDERLIST(PROVIDER)) Q:(PRIMARY'="")!(PROVIDER="") D
. I $G(^TMP("PXAIADDPRV",$J,PROVIDER))="ENC" S PRIMARY=PROVIDER
I PRIMARY="" S PRIMARY=$O(PROVIDERLIST(""))
S VPRVIEN=$P(PROVIDERLIST(PRIMARY),U,1)
;
S PXASOR=$G(^TMP("PXK",$J,"SOR"))
K ^TMP("PXK",$J)
S ^TMP("PXK",$J,"SOR")=$G(PXASOR)
S ^TMP("PXK",$J,"VST",1,"IEN")=PXAVISIT
;
S $P(AFTER0,"^",1)=$P(^AUPNVPRV(VPRVIEN,0),"^",1)
S $P(AFTER0,"^",2)=$P(^AUPNVSIT(PXAVISIT,0),"^",5)
S $P(AFTER0,"^",3)=PXAVISIT
S $P(AFTER0,"^",4)="P"
S ^TMP("PXK",$J,"PRV",22222,0,"AFTER")=AFTER0
S ^TMP("PXK",$J,"PRV",22222,0,"BEFORE")=$G(^AUPNVPRV(VPRVIEN,0))
S ^TMP("PXK",$J,"PRV",22222,"IEN")=VPRVIEN
D EN1^PXKMAIN
Q
;
OLDPRIM ;--SET A PROVIDER AS PRIMARY,replace by above in PX*2.0*211, kept
;as a reference.
N PXBCNT,PXBKY,PXBSAM,PXBSKY,AFTER0,FPRI,PRVDR,PXASOR
D PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
I $D(PRVDR) Q
I '$D(PXBSKY) Q
;----ADDED
S PXASOR=$G(^TMP("PXK",$J,"SOR"))
K ^TMP("PXK",$J)
S ^TMP("PXK",$J,"SOR")=$G(PXASOR)
S ^TMP("PXK",$J,"VST",1,"IEN")=PXAVISIT
;-------
;
S $P(AFTER0,"^",1)=$P(^AUPNVPRV($O(PXBSKY(1,0)),0),"^",1)
S $P(AFTER0,"^",2)=$P(^AUPNVSIT(PXAVISIT,0),"^",5)
S $P(AFTER0,"^",3)=PXAVISIT
S $P(AFTER0,"^",4)="P"
S ^TMP("PXK",$J,"PRV",22222,0,"AFTER")=AFTER0
S ^TMP("PXK",$J,"PRV",22222,0,"BEFORE")=$G(^AUPNVPRV($O(PXBSKY(1,0)),0))
S ^TMP("PXK",$J,"PRV",22222,"IEN")=$O(PXBSKY(1,0))
D EN1^PXKMAIN
K PXRDR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAIPRV 6098 printed Nov 22, 2024@17:36 Page 2
PXAIPRV ;ISL/JVS,ESW,PKR - SET THE PROVIDER NODES ;08/07/2020
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**5,108,124,211**;Aug 12, 1996;Build 454
+2 ;
+3 QUIT
PRV ;--CREATE PROVIDERS
+1 ;
SET ;--SET AND NEW VARIABLES
+1 NEW AFTER0,AFTER12,AFTER801,AFTER811,AFTER812
+2 NEW BEFOR0,BEFOR12,BEFOR801,BEFOR811,BEFOR812
+3 NEW NODE,PXAA,PXAB,SUB,PXAAX,IENB,STOP
+4 ;
+5 KILL PXAERR
+6 SET PXAERR(8)=PXAK
+7 SET PXAERR(7)="PROVIDER"
+8 ;
+9 SET SUB=""
FOR
SET SUB=$ORDER(@PXADATA@("PROVIDER",PXAK,SUB))
if SUB=""
QUIT
Begin DoDot:1
+10 SET PXAA(SUB)=@PXADATA@("PROVIDER",PXAK,SUB)
End DoDot:1
+11 ;
+12 ;--VALIDATE ENOUGH DATA
+13 DO VAL^PXAIPRVV
if $GET(STOP)
QUIT
+14 ;
SETVARA ;--SET VISIT VARIABLES
+1 SET $PIECE(AFTER0,"^",1)=$GET(PXAA("NAME"))
+2 IF $GET(PXAA("DELETE"))
SET $PIECE(AFTER0,"^",1)="@"
+3 SET $PIECE(AFTER0,"^",2)=$GET(PATIENT)
+4 SET $PIECE(AFTER0,"^",3)=$GET(PXAVISIT)
+5 SET $PIECE(AFTER0,"^",4)=$SELECT($GET(PXAA("PRIMARY"))=1:"P",1:"S")
+6 SET $PIECE(AFTER0,"^",5)=$SELECT($GET(PXAA("ATTENDING"))=1:"A",$GET(PXAA("ATTENDING"))=0:"@",1:"")
+7 SET $PIECE(AFTER12,"^",1)=$GET(PXAA("EVENT D/T"))
+8 SET $PIECE(AFTER811,"^",1)=$GET(PXAA("COMMENT"))
+9 SET $PIECE(AFTER812,"^",2)=$SELECT($GET(PXAA("PKG"))'="":PXAA("PKG"),1:$GET(PXAPKG))
+10 SET $PIECE(AFTER812,"^",3)=$SELECT($GET(PXAA("SOURCE"))'="":PXAA("SOURCE"),1:$GET(PXASOURC))
+11 ;
SETPXKA ;--SET PXK ARRAY AFTER
+1 SET ^TMP("PXK",$JOB,"PRV",PXAK,0,"AFTER")=AFTER0
+2 SET ^TMP("PXK",$JOB,"PRV",PXAK,12,"AFTER")=AFTER12
+3 SET ^TMP("PXK",$JOB,"PRV",PXAK,811,"AFTER")=AFTER811
+4 SET ^TMP("PXK",$JOB,"PRV",PXAK,812,"AFTER")=AFTER812
+5 ;
SETVARB ;--SET VARIABLES BEFORE
+1 ;
+2 ;--CHECK FOR PRIMARY DESIGNATION
+3 NEW ITEM,PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI
+4 DO PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
+5 ;CHECK NAME
+6 SET PXAAX("NAME")=$PIECE($GET(^VA(200,$GET(PXAA("NAME")),0)),"^",1)
+7 ;
+8 ;--GET IEN FOR 'PXK NODE'
+9 IF $GET(PXAA("DELETE"))=1
SET PXAAX("NAME")=$PIECE($GET(^VA(200,PXAA("NAME"),0)),"^",1)
+10 SET ITEM=""
IF PXBCNT>0
IF $GET(PXAAX("NAME"))]""
SET ITEM=$ORDER(PXBKY(PXAAX("NAME"),0))
+11 IF ITEM]""
SET (^TMP("PXK",$JOB,"PRV",PXAK,"IEN"),IENB)=$ORDER(PXBSKY(ITEM,0))
+12 ;
+13 IF $GET(IENB)
Begin DoDot:1
+14 FOR NODE=0,12,811,812
SET ^TMP("PXK",$JOB,"PRV",PXAK,NODE,"BEFORE")=$GET(^AUPNVPRV(IENB,NODE))
End DoDot:1
+15 IF '$TEST
Begin DoDot:1
+16 SET (BEFOR0,BEFOR12,BEFOR811,BEFOR812)=""
+17 ;
SETPXKB ;--SET PXK ARRAY BEFORE
+1 SET ^TMP("PXK",$JOB,"PRV",PXAK,0,"BEFORE")=BEFOR0
+2 SET ^TMP("PXK",$JOB,"PRV",PXAK,12,"BEFORE")=BEFOR12
+3 SET ^TMP("PXK",$JOB,"PRV",PXAK,811,"BEFORE")=BEFOR811
+4 SET ^TMP("PXK",$JOB,"PRV",PXAK,812,"BEFORE")=BEFOR812
+5 SET ^TMP("PXK",$JOB,"PRV",PXAK,"IEN")=""
End DoDot:1
+6 ;
+7 ;Package and Data Source cannot be edited.
+8 SET BEFOR812=^TMP("PXK",$JOB,"PRV",PXAK,812,"BEFORE")
+9 IF BEFOR812'=""
Begin DoDot:1
+10 IF AFTER812=BEFOR812
QUIT
+11 IF $PIECE(BEFOR812,U,2)'=""
SET $PIECE(AFTER812,U,2)=$PIECE(BEFOR812,U,2)
+12 IF $PIECE(BEFOR812,U,3)'=""
SET $PIECE(AFTER812,U,3)=$PIECE(BEFOR812,U,3)
+13 SET ^TMP("PXK",$JOB,"PRV",PXAK,812,"AFTER")=AFTER812
End DoDot:1
+14 ;
MISC ;--MISCELLANEOUS NODE
+1 ;
+2 QUIT
OTHER ;---ADD OTHER PROVIDERS TO V PROVIDER FOR OTHER ENTRIES
+1 ;
+2 ; generate data, PXBSKY(), about currently filed providers
+3 ;
+4 NEW PXBSKY
+5 IF $GET(PXAVISIT)
DO PRV^PXBGPRV(PXAVISIT,.PXBSKY)
+6 ;
+7 NEW IEN,AFTER0,CNT,PXAK,STOP,FF
+8 SET IEN=""
SET CNT=1000
+9 ;
+10 ;---^TMP("PXAIADDPRV",$J,'IEN')=""
+11 ;
+12 FOR
SET IEN=$ORDER(^TMP("PXAIADDPRV",$JOB,IEN))
SET CNT=CNT+1
if IEN=""
QUIT
Begin DoDot:1
+13 ;
+14 ;verify if an entry for a provider already exists
+15 ;
+16 SET STOP=0
+17 IF $DATA(^TMP("PXK",$JOB,"PRV"))
SET PXAK=""
Begin DoDot:2
+18 FOR
SET PXAK=$ORDER(^TMP("PXK",$JOB,"PRV",PXAK))
if PXAK=""
QUIT
Begin DoDot:3
+19 IF +$GET(^TMP("PXK",$JOB,"PRV",PXAK,0,"AFTER"))=IEN
SET STOP=1
End DoDot:3
if STOP
QUIT
End DoDot:2
if STOP
QUIT
+20 SET FF="PXBSKY"
FOR
SET FF=$QUERY(@FF)
if FF=""
QUIT
IF @FF=IEN
SET STOP=1
QUIT
+21 if STOP
QUIT
+22 ;
+23 SET $PIECE(AFTER0,"^",1)=IEN
+24 SET $PIECE(AFTER0,"^",2)=$PIECE(^AUPNVSIT(PXAVISIT,0),"^",5)
+25 SET $PIECE(AFTER0,"^",3)=PXAVISIT
+26 SET $PIECE(AFTER0,"^",4)="S"
+27 SET $PIECE(AFTER812,"^",2)=$GET(PXAPKG)
+28 SET $PIECE(AFTER812,"^",3)=$GET(PXASOURC)
+29 SET ^TMP("PXK",$JOB,"PRV",CNT,0,"AFTER")=$GET(AFTER0)
+30 SET ^TMP("PXK",$JOB,"PRV",CNT,811,"AFTER")=""
+31 SET ^TMP("PXK",$JOB,"PRV",CNT,812,"AFTER")=$GET(AFTER812)
+32 SET ^TMP("PXK",$JOB,"PRV",CNT,0,"BEFORE")=""
+33 SET ^TMP("PXK",$JOB,"PRV",CNT,811,"BEFORE")=""
+34 SET ^TMP("PXK",$JOB,"PRV",CNT,812,"BEFORE")=""
+35 SET ^TMP("PXK",$JOB,"PRV",CNT,"IEN")=""
End DoDot:1
+36 QUIT
+37 ;
PRIM ;--SET A PROVIDER AS PRIMARY
+1 NEW NPRIM,NPROV,PORS,PRIMARY,PROVIDER,PROVIDERLIST,VPRVIEN
+2 SET (NPRIM,NPROV,VPRVIEN)=0
+3 FOR
SET VPRVIEN=+$ORDER(^AUPNVPRV("AD",PXAVISIT,VPRVIEN))
if VPRVIEN=0
QUIT
Begin DoDot:1
+4 SET NPROV=NPROV+1
+5 SET TEMP=^AUPNVPRV(VPRVIEN,0)
+6 SET PROVIDER=$PIECE(TEMP,U,1)
+7 SET PORS=$PIECE(TEMP,U,4)
+8 SET PROVIDERLIST(PROVIDER)=VPRVIEN_U_PORS
+9 IF PORS="P"
SET NPRIM=NPRIM+1
End DoDot:1
+10 ;If there is a primary provider or no providers quit.
+11 IF (NPRIM=1)!(NPROV=0)
KILL ^TMP("PXAIADDPRV",$JOB)
QUIT
+12 ;No primary provider found, first use the encounter provider with
+13 ;the lowest DUZ and if there is no encounter provider use the
+14 ;ordering provider.
+15 SET (PRIMARY,PROVIDER)=""
+16 FOR
SET PROVIDER=$ORDER(PROVIDERLIST(PROVIDER))
if (PRIMARY'="")!(PROVIDER="")
QUIT
Begin DoDot:1
+17 IF $GET(^TMP("PXAIADDPRV",$JOB,PROVIDER))="ENC"
SET PRIMARY=PROVIDER
End DoDot:1
+18 IF PRIMARY=""
SET PRIMARY=$ORDER(PROVIDERLIST(""))
+19 SET VPRVIEN=$PIECE(PROVIDERLIST(PRIMARY),U,1)
+20 ;
+21 SET PXASOR=$GET(^TMP("PXK",$JOB,"SOR"))
+22 KILL ^TMP("PXK",$JOB)
+23 SET ^TMP("PXK",$JOB,"SOR")=$GET(PXASOR)
+24 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXAVISIT
+25 ;
+26 SET $PIECE(AFTER0,"^",1)=$PIECE(^AUPNVPRV(VPRVIEN,0),"^",1)
+27 SET $PIECE(AFTER0,"^",2)=$PIECE(^AUPNVSIT(PXAVISIT,0),"^",5)
+28 SET $PIECE(AFTER0,"^",3)=PXAVISIT
+29 SET $PIECE(AFTER0,"^",4)="P"
+30 SET ^TMP("PXK",$JOB,"PRV",22222,0,"AFTER")=AFTER0
+31 SET ^TMP("PXK",$JOB,"PRV",22222,0,"BEFORE")=$GET(^AUPNVPRV(VPRVIEN,0))
+32 SET ^TMP("PXK",$JOB,"PRV",22222,"IEN")=VPRVIEN
+33 DO EN1^PXKMAIN
+34 QUIT
+35 ;
OLDPRIM ;--SET A PROVIDER AS PRIMARY,replace by above in PX*2.0*211, kept
+1 ;as a reference.
+2 NEW PXBCNT,PXBKY,PXBSAM,PXBSKY,AFTER0,FPRI,PRVDR,PXASOR
+3 DO PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
+4 IF $DATA(PRVDR)
QUIT
+5 IF '$DATA(PXBSKY)
QUIT
+6 ;----ADDED
+7 SET PXASOR=$GET(^TMP("PXK",$JOB,"SOR"))
+8 KILL ^TMP("PXK",$JOB)
+9 SET ^TMP("PXK",$JOB,"SOR")=$GET(PXASOR)
+10 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXAVISIT
+11 ;-------
+12 ;
+13 SET $PIECE(AFTER0,"^",1)=$PIECE(^AUPNVPRV($ORDER(PXBSKY(1,0)),0),"^",1)
+14 SET $PIECE(AFTER0,"^",2)=$PIECE(^AUPNVSIT(PXAVISIT,0),"^",5)
+15 SET $PIECE(AFTER0,"^",3)=PXAVISIT
+16 SET $PIECE(AFTER0,"^",4)="P"
+17 SET ^TMP("PXK",$JOB,"PRV",22222,0,"AFTER")=AFTER0
+18 SET ^TMP("PXK",$JOB,"PRV",22222,0,"BEFORE")=$GET(^AUPNVPRV($ORDER(PXBSKY(1,0)),0))
+19 SET ^TMP("PXK",$JOB,"PRV",22222,"IEN")=$ORDER(PXBSKY(1,0))
+20 DO EN1^PXKMAIN
+21 KILL PXRDR
+22 QUIT
