PXKENCOUNTER ;SLC/PKR - Builds an array of all encounter data. ;11/22/2021
;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
Q
;
COEVENT(VISITIEN) ;Add to the ^TMP("PXKCO",$J, array the
;already exisiting encounter data. This is for the PXK VISIT
;DATA event.
I $G(VISITIEN)'>0 Q ;PX/183
I '$D(^AUPNVSIT(VISITIEN)) Q
N CSTPIEN,IND,MODIFIER,NODE,NUMM,NUMP,NUMS,PRV,PRVLIST,PS,TEMP,TMPSUB,VFIEN
S TMPSUB="PXKCO"
;Credit Stop Visits
S CSTPIEN=""
F S CSTPIEN=$O(^AUPNVSIT("AD",VISITIEN,CSTPIEN)) Q:CSTPIEN="" D
. I "SC"'[$P($G(^AUPNVSIT(CSTPIEN,150)),"^",3) Q
. S NODE=""
. F S NODE=$O(^AUPNVSIT(CSTPIEN,NODE)) Q:(NODE'=+NODE) D
.. S ^TMP(TMPSUB,$J,VISITIEN,"CSTP",CSTPIEN,NODE,"AFTER")=^AUPNVSIT(CSTPIEN,NODE)
.. S ^TMP(TMPSUB,$J,VISITIEN,"CSTP",CSTPIEN,NODE,"BEFORE")=^AUPNVSIT(CSTPIEN,NODE)
;
;V CPT
S VFIEN=""
F S VFIEN=$O(^AUPNVCPT("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVCPT(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
..;Modifiers.
.. I NODE=1 D
... S IND=0
... F S IND=+$O(^AUPNVCPT(VFIEN,NODE,IND)) Q:IND=0 D
.... S MODIFIER=^AUPNVCPT(VFIEN,NODE,IND,0)
.... S ^TMP(TMPSUB,$J,VISITIEN,"CPT",VFIEN,NODE,"AFTER",MODIFIER)=""
.... S ^TMP(TMPSUB,$J,VISITIEN,"CPT",VFIEN,NODE,"BEFORE",MODIFIER)=""
.. E D
... S ^TMP(TMPSUB,$J,VISITIEN,"CPT",VFIEN,NODE,"AFTER")=^AUPNVCPT(VFIEN,NODE)
... S ^TMP(TMPSUB,$J,VISITIEN,"CPT",VFIEN,NODE,"BEFORE")=^AUPNVCPT(VFIEN,NODE)
;
;V EXAM
S VFIEN=""
F S VFIEN=$O(^AUPNVXAM("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVXAM(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"XAM",VFIEN,NODE,"AFTER")=^AUPNVXAM(VFIEN,NODE)
.. S ^TMP(TMPSUB,$J,VISITIEN,"XAM",VFIEN,NODE,"BEFORE")=^AUPNVXAM(VFIEN,NODE)
;
;V HF
S VFIEN=""
F S VFIEN=$O(^AUPNVHF("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVHF(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"HF",VFIEN,NODE,"AFTER")=^AUPNVHF(VFIEN,NODE)
.. S ^TMP(TMPSUB,$J,VISITIEN,"HF",VFIEN,NODE,"BEFORE")=^AUPNVHF(VFIEN,NODE)
;
;V ICR
S VFIEN=""
F S VFIEN=$O(^AUPNVICR("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVICR(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"ICR",VFIEN,NODE,"AFTER")=^AUPNVICR(VFIEN,NODE)
.. S ^TMP(TMPSUB,$J,VISITIEN,"ICR",VFIEN,NODE,"BEFORE")=^AUPNVICR(VFIEN,NODE)
;
;V IMM
S VFIEN=""
F S VFIEN=$O(^AUPNVIMM("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVIMM(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
..;Fields that are multiples.
.. I (NODE=2)!(NODE=3)!(NODE=11) D
... S IND=0
... F S IND=+$O(^AUPNVIMM(VFIEN,NODE,IND)) Q:IND=0 D
.... S TEMP=^AUPNVIMM(VFIEN,NODE,IND,0)
.... S ^TMP(TMPSUB,$J,VISITIEN,"IMM",VFIEN,NODE,"AFTER",IND)=TEMP
.... S ^TMP(TMPSUB,$J,VISITIEN,"IMM",VFIEN,NODE,"BEFORE",IND)=TEMP
.. E D
... S ^TMP(TMPSUB,$J,VISITIEN,"IMM",VFIEN,NODE,"AFTER")=^AUPNVIMM(VFIEN,NODE)
... S ^TMP(TMPSUB,$J,VISITIEN,"IMM",VFIEN,NODE,"BEFORE")=^AUPNVIMM(VFIEN,NODE)
;
;V PED
S VFIEN=""
F S VFIEN=$O(^AUPNVPED("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVPED(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"PED",VFIEN,NODE,"AFTER")=^AUPNVPED(VFIEN,NODE)
.. S ^TMP(TMPSUB,$J,VISITIEN,"PED",VFIEN,NODE,"BEFORE")=^AUPNVPED(VFIEN,NODE)
;
;V POV
S VFIEN=""
F S VFIEN=$O(^AUPNVPOV("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVPOV(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"POV",VFIEN,NODE,"AFTER")=^AUPNVPOV(VFIEN,NODE)
.. S ^TMP(TMPSUB,$J,VISITIEN,"POV",VFIEN,NODE,"BEFORE")=^AUPNVPOV(VFIEN,NODE)
;
;V PROVIDER
S VFIEN=""
F S VFIEN=$O(^AUPNVPRV("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVPRV(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. I NODE=0 D
... S TEMP=^AUPNVPRV(VFIEN,NODE),PRV=$P(TEMP,U,1),PS=$P(TEMP,U,4)
...;Primary/Secondary is a required field but it is possible for it
...;to be missing.
... I PS="" S PS="M"
... S PRVLIST(PRV,"CNT")=$G(PRVLIST(PRV,"CNT"))+1
... S PRVLIST(PRV,PS,"CNT")=$G(PRVLIST(PRV,PS,"CNT"))+1
... S PRVLIST(PRV,PS,PRVLIST(PRV,"CNT"))=VFIEN
.. S ^TMP(TMPSUB,$J,VISITIEN,"PRV",VFIEN,NODE,"AFTER")=^AUPNVPRV(VFIEN,NODE)
.. S ^TMP(TMPSUB,$J,VISITIEN,"PRV",VFIEN,NODE,"BEFORE")=^AUPNVPRV(VFIEN,NODE)
;Remove duplicates.
S PRV=""
F S PRV=$O(PRVLIST(PRV)) Q:PRV="" D
. I PRVLIST(PRV,"CNT")=1 Q
. S NUMM=+$G(PRVLIST(PRV,"M","CNT"))
. S NUMP=+$G(PRVLIST(PRV,"P","CNT"))
. S NUMS=+$G(PRVLIST(PRV,"S","CNT"))
.;Remove any entries that are missing the Primary/Secondary designation.
. I NUMM>0 F IND=1:1:NUMM S VFIEN=PRVLIST(PRV,"M",IND) K ^TMP(TMPSUB,$J,VISITIEN,"PRV",VFIEN)
.;If this provider is listed as primary more than once, delete the other primaries.
. I NUMP>1 D
.. F IND=2:1:NUMP S VFIEN=PRVLIST(PRV,"P",IND) K ^TMP(TMPSUB,$J,VISITIEN,"PRV",VFIEN)
..;If this provider is a primary, delete all its secondaries and missing.
. I NUMP>0 D
.. F IND=1:1:NUMS S VFIEN=PRVLIST(PRV,"S",IND) K ^TMP(TMPSUB,$J,VISITIEN,"PRV",VFIEN)
.. S NUMS=0
.;If this provider is not primary, only keep the first secondary.
. I NUMS>1 D
.. F IND=2:1:NUMS D
... S VFIEN=PRVLIST(PRV,"S",IND)
... K ^TMP(TMPSUB,$J,VISITIEN,"PRV",VFIEN)
;
;V SC
S VFIEN=""
F S VFIEN=$O(^AUPNVSC("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVSC(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"SC",VFIEN,NODE,"AFTER")=^AUPNVSC(VFIEN,NODE)
.. S ^TMP(TMPSUB,$J,VISITIEN,"SC",VFIEN,NODE,"BEFORE")=^AUPNVSC(VFIEN,NODE)
;
;V SKIN
S VFIEN=""
F S VFIEN=$O(^AUPNVSK("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVSK(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"SK",VFIEN,NODE,"AFTER")=^AUPNVSK(VFIEN,NODE)
.. S ^TMP(TMPSUB,$J,VISITIEN,"SK",VFIEN,NODE,"BEFORE")=^AUPNVSK(VFIEN,NODE)
;
;V TRT
S VFIEN=""
F S VFIEN=$O(^AUPNVTRT("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVTRT(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"TRT",VFIEN,NODE,"AFTER")=^AUPNVTRT(VFIEN,NODE)
.. S ^TMP(TMPSUB,$J,VISITIEN,"TRT",VFIEN,NODE,"BEFORE")=^AUPNVTRT(VFIEN,NODE)
Q
;
ENCEVENT(VISITIEN,DONTKILL) ;Create the ^TMP("PKRENC",$J, array of all the
;information about one encounter.
;Parameters:
; VISITIEN Pointer to the Visit (#9000010)
; DONOTKILL is 1 if the output array is not to be killed before used
; and 0 or null if the array is to be killed (cleaned out)
;
; The encounter is returned in the array
; ^TMP("PXKENC",$J,pointer to visit)
;
I $G(VISITIEN)'>0 Q ;PX/183
I '$D(^AUPNVSIT(VISITIEN)) Q
N CSTPIEN,IND,NODE,NUMM,NUMP,NUMS,PRV,PRVLIST,PS,TEMP,TMPSUB,VFIEN
S TMPSUB="PXKENC"
K:'$G(DONTKILL) ^TMP(TMPSUB,$J)
;Visit and Credit Stop Visits
S NODE=""
F S NODE=$O(^AUPNVSIT(VISITIEN,NODE)) Q:(NODE'=+NODE) D
. S ^TMP(TMPSUB,$J,VISITIEN,"VST",VISITIEN,NODE)=^AUPNVSIT(VISITIEN,NODE)
S CSTPIEN=""
F S CSTPIEN=$O(^AUPNVSIT("AD",VISITIEN,CSTPIEN)) Q:CSTPIEN="" D
. I "SC"'[$P($G(^AUPNVSIT(CSTPIEN,150)),"^",3) Q
. S NODE=""
. F S NODE=$O(^AUPNVSIT(CSTPIEN,NODE)) Q:(NODE'=+NODE) D
.. S ^TMP(TMPSUB,$J,VISITIEN,"CSTP",CSTPIEN,NODE)=^AUPNVSIT(CSTPIEN,NODE)
;
;V CPT
S VFIEN=""
F S VFIEN=$O(^AUPNVCPT("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVCPT(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
..;Modifiers.
.. I NODE=1 D
... S ^TMP(TMPSUB,$J,VISITIEN,"CPT",VFIEN,NODE,0)=^AUPNVCPT(VFIEN,NODE,0)
... S IND=0
... F S IND=+$O(^AUPNVCPT(VFIEN,NODE,IND)) Q:IND=0 D
.... S ^TMP(TMPSUB,$J,VISITIEN,"CPT",VFIEN,NODE,IND,0)=^AUPNVCPT(VFIEN,NODE,IND,0)
.. E S ^TMP(TMPSUB,$J,VISITIEN,"CPT",VFIEN,NODE)=^AUPNVCPT(VFIEN,NODE)
;
;V EXAM
S VFIEN=""
F S VFIEN=$O(^AUPNVXAM("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVXAM(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"XAM",VFIEN,NODE)=^AUPNVXAM(VFIEN,NODE)
;
;V HF
S VFIEN=""
F S VFIEN=$O(^AUPNVHF("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVHF(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"HF",VFIEN,NODE)=^AUPNVHF(VFIEN,NODE)
;
;V ICR
S VFIEN=""
F S VFIEN=$O(^AUPNVICR("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVICR(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"ICR",VFIEN,NODE)=^AUPNVICR(VFIEN,NODE)
;
;V IMM
S VFIEN=""
F S VFIEN=$O(^AUPNVIMM("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVIMM(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
..;Fields that are multiples.
.. I (NODE=2)!(NODE=3)!(NODE=11) D
... S ^TMP(TMPSUB,$J,VISITIEN,"IMM",VFIEN,NODE,0)=^AUPNVIMM(VFIEN,NODE,0)
... S IND=0
... F S IND=+$O(^AUPNVIMM(VFIEN,NODE,IND)) Q:IND=0 D
.... S ^TMP(TMPSUB,$J,VISITIEN,"IMM",VFIEN,NODE,IND,0)=^AUPNVIMM(VFIEN,NODE,IND,0)
.. E S ^TMP(TMPSUB,$J,VISITIEN,"IMM",VFIEN,NODE)=^AUPNVIMM(VFIEN,NODE)
;
;V PED
S VFIEN=""
F S VFIEN=$O(^AUPNVPED("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVPED(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"PED",VFIEN,NODE)=^AUPNVPED(VFIEN,NODE)
;
;V POV
S VFIEN=""
F S VFIEN=$O(^AUPNVPOV("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVPOV(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"POV",VFIEN,NODE)=^AUPNVPOV(VFIEN,NODE)
..;Check for bad Provider Narrative Category pointer.
.. I (NODE=802),(^AUPNVPOV(VFIEN,NODE)'>0) S ^TMP(TMPSUB,$J,VISITIEN,"POV",VFIEN,NODE)=""
;
;V PROVIDER
S VFIEN=""
F S VFIEN=$O(^AUPNVPRV("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVPRV(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"PRV",VFIEN,NODE)=^AUPNVPRV(VFIEN,NODE)
.. I NODE=0 D
... S TEMP=^AUPNVPRV(VFIEN,NODE),PRV=$P(TEMP,U,1),PS=$P(TEMP,U,4)
...;Primary/Secondary is a required field but it is possible for it
...;to be missing.
... I PS="" S PS="M"
... S PRVLIST(PRV,"CNT")=$G(PRVLIST(PRV,"CNT"))+1
... S PRVLIST(PRV,PS,"CNT")=$G(PRVLIST(PRV,PS,"CNT"))+1
... S PRVLIST(PRV,PS,PRVLIST(PRV,PS,"CNT"))=VFIEN
;Remove duplicates.
S PRV=""
F S PRV=$O(PRVLIST(PRV)) Q:PRV="" D
. I PRVLIST(PRV,"CNT")=1 Q
. S NUMM=+$G(PRVLIST(PRV,"M","CNT"))
. S NUMP=+$G(PRVLIST(PRV,"P","CNT"))
. S NUMS=+$G(PRVLIST(PRV,"S","CNT"))
.;Remove any entries that are missing the Primary/Secondary designation.
. I NUMM>0 F IND=1:1:NUMM S VFIEN=PRVLIST(PRV,"M",IND) K ^TMP(TMPSUB,$J,VISITIEN,"PRV",VFIEN)
.;If this provider is listed as primary more than once, delete the other primaries.
. I NUMP>1 D
.. F IND=2:1:NUMP S VFIEN=PRVLIST(PRV,"P",IND) K ^TMP(TMPSUB,$J,VISITIEN,"PRV",VFIEN)
..;If this provider is a primary, delete all its secondaries and missing.
. I NUMP>0 D
.. F IND=1:1:NUMS S VFIEN=PRVLIST(PRV,"S",IND) K ^TMP(TMPSUB,$J,VISITIEN,"PRV",VFIEN)
.. S NUMS=0
.;If this provider is not primary, only keep the first secondary.
. I NUMS>1 D
.. F IND=2:1:NUMS D
... S VFIEN=PRVLIST(PRV,"S",IND)
... K ^TMP(TMPSUB,$J,VISITIEN,"PRV",VFIEN)
;
;V SC
S VFIEN=""
F S VFIEN=$O(^AUPNVSC("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVSC(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"SC",VFIEN,NODE)=^AUPNVSC(VFIEN,NODE)
;
;V SKIN
S VFIEN=""
F S VFIEN=$O(^AUPNVSK("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVSK(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"SK",VFIEN,NODE)=^AUPNVSK(VFIEN,NODE)
;
;V TRT
S VFIEN=""
F S VFIEN=$O(^AUPNVTRT("AD",VISITIEN,VFIEN)) Q:VFIEN="" D
. S NODE=""
. F S NODE=$O(^AUPNVTRT(VFIEN,NODE)) Q:(NODE'=+NODE) D
.. I NODE=801 Q
.. S ^TMP(TMPSUB,$J,VISITIEN,"TRT",VFIEN,NODE)=^AUPNVTRT(VFIEN,NODE)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXKENCOUNTER 12358 printed Sep 23, 2025@20:05:10 Page 2
PXKENCOUNTER ;SLC/PKR - Builds an array of all encounter data. ;11/22/2021
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134
+2 QUIT
+3 ;
COEVENT(VISITIEN) ;Add to the ^TMP("PXKCO",$J, array the
+1 ;already exisiting encounter data. This is for the PXK VISIT
+2 ;DATA event.
+3 ;PX/183
IF $GET(VISITIEN)'>0
QUIT
+4 IF '$DATA(^AUPNVSIT(VISITIEN))
QUIT
+5 NEW CSTPIEN,IND,MODIFIER,NODE,NUMM,NUMP,NUMS,PRV,PRVLIST,PS,TEMP,TMPSUB,VFIEN
+6 SET TMPSUB="PXKCO"
+7 ;Credit Stop Visits
+8 SET CSTPIEN=""
+9 FOR
SET CSTPIEN=$ORDER(^AUPNVSIT("AD",VISITIEN,CSTPIEN))
if CSTPIEN=""
QUIT
Begin DoDot:1
+10 IF "SC"'[$PIECE($GET(^AUPNVSIT(CSTPIEN,150)),"^",3)
QUIT
+11 SET NODE=""
+12 FOR
SET NODE=$ORDER(^AUPNVSIT(CSTPIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+13 SET ^TMP(TMPSUB,$JOB,VISITIEN,"CSTP",CSTPIEN,NODE,"AFTER")=^AUPNVSIT(CSTPIEN,NODE)
+14 SET ^TMP(TMPSUB,$JOB,VISITIEN,"CSTP",CSTPIEN,NODE,"BEFORE")=^AUPNVSIT(CSTPIEN,NODE)
End DoDot:2
End DoDot:1
+15 ;
+16 ;V CPT
+17 SET VFIEN=""
+18 FOR
SET VFIEN=$ORDER(^AUPNVCPT("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+19 SET NODE=""
+20 FOR
SET NODE=$ORDER(^AUPNVCPT(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+21 IF NODE=801
QUIT
+22 ;Modifiers.
+23 IF NODE=1
Begin DoDot:3
+24 SET IND=0
+25 FOR
SET IND=+$ORDER(^AUPNVCPT(VFIEN,NODE,IND))
if IND=0
QUIT
Begin DoDot:4
+26 SET MODIFIER=^AUPNVCPT(VFIEN,NODE,IND,0)
+27 SET ^TMP(TMPSUB,$JOB,VISITIEN,"CPT",VFIEN,NODE,"AFTER",MODIFIER)=""
+28 SET ^TMP(TMPSUB,$JOB,VISITIEN,"CPT",VFIEN,NODE,"BEFORE",MODIFIER)=""
End DoDot:4
End DoDot:3
+29 IF '$TEST
Begin DoDot:3
+30 SET ^TMP(TMPSUB,$JOB,VISITIEN,"CPT",VFIEN,NODE,"AFTER")=^AUPNVCPT(VFIEN,NODE)
+31 SET ^TMP(TMPSUB,$JOB,VISITIEN,"CPT",VFIEN,NODE,"BEFORE")=^AUPNVCPT(VFIEN,NODE)
End DoDot:3
End DoDot:2
End DoDot:1
+32 ;
+33 ;V EXAM
+34 SET VFIEN=""
+35 FOR
SET VFIEN=$ORDER(^AUPNVXAM("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+36 SET NODE=""
+37 FOR
SET NODE=$ORDER(^AUPNVXAM(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+38 IF NODE=801
QUIT
+39 SET ^TMP(TMPSUB,$JOB,VISITIEN,"XAM",VFIEN,NODE,"AFTER")=^AUPNVXAM(VFIEN,NODE)
+40 SET ^TMP(TMPSUB,$JOB,VISITIEN,"XAM",VFIEN,NODE,"BEFORE")=^AUPNVXAM(VFIEN,NODE)
End DoDot:2
End DoDot:1
+41 ;
+42 ;V HF
+43 SET VFIEN=""
+44 FOR
SET VFIEN=$ORDER(^AUPNVHF("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+45 SET NODE=""
+46 FOR
SET NODE=$ORDER(^AUPNVHF(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+47 IF NODE=801
QUIT
+48 SET ^TMP(TMPSUB,$JOB,VISITIEN,"HF",VFIEN,NODE,"AFTER")=^AUPNVHF(VFIEN,NODE)
+49 SET ^TMP(TMPSUB,$JOB,VISITIEN,"HF",VFIEN,NODE,"BEFORE")=^AUPNVHF(VFIEN,NODE)
End DoDot:2
End DoDot:1
+50 ;
+51 ;V ICR
+52 SET VFIEN=""
+53 FOR
SET VFIEN=$ORDER(^AUPNVICR("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+54 SET NODE=""
+55 FOR
SET NODE=$ORDER(^AUPNVICR(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+56 IF NODE=801
QUIT
+57 SET ^TMP(TMPSUB,$JOB,VISITIEN,"ICR",VFIEN,NODE,"AFTER")=^AUPNVICR(VFIEN,NODE)
+58 SET ^TMP(TMPSUB,$JOB,VISITIEN,"ICR",VFIEN,NODE,"BEFORE")=^AUPNVICR(VFIEN,NODE)
End DoDot:2
End DoDot:1
+59 ;
+60 ;V IMM
+61 SET VFIEN=""
+62 FOR
SET VFIEN=$ORDER(^AUPNVIMM("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+63 SET NODE=""
+64 FOR
SET NODE=$ORDER(^AUPNVIMM(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+65 IF NODE=801
QUIT
+66 ;Fields that are multiples.
+67 IF (NODE=2)!(NODE=3)!(NODE=11)
Begin DoDot:3
+68 SET IND=0
+69 FOR
SET IND=+$ORDER(^AUPNVIMM(VFIEN,NODE,IND))
if IND=0
QUIT
Begin DoDot:4
+70 SET TEMP=^AUPNVIMM(VFIEN,NODE,IND,0)
+71 SET ^TMP(TMPSUB,$JOB,VISITIEN,"IMM",VFIEN,NODE,"AFTER",IND)=TEMP
+72 SET ^TMP(TMPSUB,$JOB,VISITIEN,"IMM",VFIEN,NODE,"BEFORE",IND)=TEMP
End DoDot:4
End DoDot:3
+73 IF '$TEST
Begin DoDot:3
+74 SET ^TMP(TMPSUB,$JOB,VISITIEN,"IMM",VFIEN,NODE,"AFTER")=^AUPNVIMM(VFIEN,NODE)
+75 SET ^TMP(TMPSUB,$JOB,VISITIEN,"IMM",VFIEN,NODE,"BEFORE")=^AUPNVIMM(VFIEN,NODE)
End DoDot:3
End DoDot:2
End DoDot:1
+76 ;
+77 ;V PED
+78 SET VFIEN=""
+79 FOR
SET VFIEN=$ORDER(^AUPNVPED("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+80 SET NODE=""
+81 FOR
SET NODE=$ORDER(^AUPNVPED(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+82 IF NODE=801
QUIT
+83 SET ^TMP(TMPSUB,$JOB,VISITIEN,"PED",VFIEN,NODE,"AFTER")=^AUPNVPED(VFIEN,NODE)
+84 SET ^TMP(TMPSUB,$JOB,VISITIEN,"PED",VFIEN,NODE,"BEFORE")=^AUPNVPED(VFIEN,NODE)
End DoDot:2
End DoDot:1
+85 ;
+86 ;V POV
+87 SET VFIEN=""
+88 FOR
SET VFIEN=$ORDER(^AUPNVPOV("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+89 SET NODE=""
+90 FOR
SET NODE=$ORDER(^AUPNVPOV(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+91 IF NODE=801
QUIT
+92 SET ^TMP(TMPSUB,$JOB,VISITIEN,"POV",VFIEN,NODE,"AFTER")=^AUPNVPOV(VFIEN,NODE)
+93 SET ^TMP(TMPSUB,$JOB,VISITIEN,"POV",VFIEN,NODE,"BEFORE")=^AUPNVPOV(VFIEN,NODE)
End DoDot:2
End DoDot:1
+94 ;
+95 ;V PROVIDER
+96 SET VFIEN=""
+97 FOR
SET VFIEN=$ORDER(^AUPNVPRV("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+98 SET NODE=""
+99 FOR
SET NODE=$ORDER(^AUPNVPRV(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+100 IF NODE=801
QUIT
+101 IF NODE=0
Begin DoDot:3
+102 SET TEMP=^AUPNVPRV(VFIEN,NODE)
SET PRV=$PIECE(TEMP,U,1)
SET PS=$PIECE(TEMP,U,4)
+103 ;Primary/Secondary is a required field but it is possible for it
+104 ;to be missing.
+105 IF PS=""
SET PS="M"
+106 SET PRVLIST(PRV,"CNT")=$GET(PRVLIST(PRV,"CNT"))+1
+107 SET PRVLIST(PRV,PS,"CNT")=$GET(PRVLIST(PRV,PS,"CNT"))+1
+108 SET PRVLIST(PRV,PS,PRVLIST(PRV,"CNT"))=VFIEN
End DoDot:3
+109 SET ^TMP(TMPSUB,$JOB,VISITIEN,"PRV",VFIEN,NODE,"AFTER")=^AUPNVPRV(VFIEN,NODE)
+110 SET ^TMP(TMPSUB,$JOB,VISITIEN,"PRV",VFIEN,NODE,"BEFORE")=^AUPNVPRV(VFIEN,NODE)
End DoDot:2
End DoDot:1
+111 ;Remove duplicates.
+112 SET PRV=""
+113 FOR
SET PRV=$ORDER(PRVLIST(PRV))
if PRV=""
QUIT
Begin DoDot:1
+114 IF PRVLIST(PRV,"CNT")=1
QUIT
+115 SET NUMM=+$GET(PRVLIST(PRV,"M","CNT"))
+116 SET NUMP=+$GET(PRVLIST(PRV,"P","CNT"))
+117 SET NUMS=+$GET(PRVLIST(PRV,"S","CNT"))
+118 ;Remove any entries that are missing the Primary/Secondary designation.
+119 IF NUMM>0
FOR IND=1:1:NUMM
SET VFIEN=PRVLIST(PRV,"M",IND)
KILL ^TMP(TMPSUB,$JOB,VISITIEN,"PRV",VFIEN)
+120 ;If this provider is listed as primary more than once, delete the other primaries.
+121 IF NUMP>1
Begin DoDot:2
+122 FOR IND=2:1:NUMP
SET VFIEN=PRVLIST(PRV,"P",IND)
KILL ^TMP(TMPSUB,$JOB,VISITIEN,"PRV",VFIEN)
+123 ;If this provider is a primary, delete all its secondaries and missing.
End DoDot:2
+124 IF NUMP>0
Begin DoDot:2
+125 FOR IND=1:1:NUMS
SET VFIEN=PRVLIST(PRV,"S",IND)
KILL ^TMP(TMPSUB,$JOB,VISITIEN,"PRV",VFIEN)
+126 SET NUMS=0
End DoDot:2
+127 ;If this provider is not primary, only keep the first secondary.
+128 IF NUMS>1
Begin DoDot:2
+129 FOR IND=2:1:NUMS
Begin DoDot:3
+130 SET VFIEN=PRVLIST(PRV,"S",IND)
+131 KILL ^TMP(TMPSUB,$JOB,VISITIEN,"PRV",VFIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+132 ;
+133 ;V SC
+134 SET VFIEN=""
+135 FOR
SET VFIEN=$ORDER(^AUPNVSC("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+136 SET NODE=""
+137 FOR
SET NODE=$ORDER(^AUPNVSC(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+138 IF NODE=801
QUIT
+139 SET ^TMP(TMPSUB,$JOB,VISITIEN,"SC",VFIEN,NODE,"AFTER")=^AUPNVSC(VFIEN,NODE)
+140 SET ^TMP(TMPSUB,$JOB,VISITIEN,"SC",VFIEN,NODE,"BEFORE")=^AUPNVSC(VFIEN,NODE)
End DoDot:2
End DoDot:1
+141 ;
+142 ;V SKIN
+143 SET VFIEN=""
+144 FOR
SET VFIEN=$ORDER(^AUPNVSK("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+145 SET NODE=""
+146 FOR
SET NODE=$ORDER(^AUPNVSK(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+147 IF NODE=801
QUIT
+148 SET ^TMP(TMPSUB,$JOB,VISITIEN,"SK",VFIEN,NODE,"AFTER")=^AUPNVSK(VFIEN,NODE)
+149 SET ^TMP(TMPSUB,$JOB,VISITIEN,"SK",VFIEN,NODE,"BEFORE")=^AUPNVSK(VFIEN,NODE)
End DoDot:2
End DoDot:1
+150 ;
+151 ;V TRT
+152 SET VFIEN=""
+153 FOR
SET VFIEN=$ORDER(^AUPNVTRT("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+154 SET NODE=""
+155 FOR
SET NODE=$ORDER(^AUPNVTRT(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+156 IF NODE=801
QUIT
+157 SET ^TMP(TMPSUB,$JOB,VISITIEN,"TRT",VFIEN,NODE,"AFTER")=^AUPNVTRT(VFIEN,NODE)
+158 SET ^TMP(TMPSUB,$JOB,VISITIEN,"TRT",VFIEN,NODE,"BEFORE")=^AUPNVTRT(VFIEN,NODE)
End DoDot:2
End DoDot:1
+159 QUIT
+160 ;
ENCEVENT(VISITIEN,DONTKILL) ;Create the ^TMP("PKRENC",$J, array of all the
+1 ;information about one encounter.
+2 ;Parameters:
+3 ; VISITIEN Pointer to the Visit (#9000010)
+4 ; DONOTKILL is 1 if the output array is not to be killed before used
+5 ; and 0 or null if the array is to be killed (cleaned out)
+6 ;
+7 ; The encounter is returned in the array
+8 ; ^TMP("PXKENC",$J,pointer to visit)
+9 ;
+10 ;PX/183
IF $GET(VISITIEN)'>0
QUIT
+11 IF '$DATA(^AUPNVSIT(VISITIEN))
QUIT
+12 NEW CSTPIEN,IND,NODE,NUMM,NUMP,NUMS,PRV,PRVLIST,PS,TEMP,TMPSUB,VFIEN
+13 SET TMPSUB="PXKENC"
+14 if '$GET(DONTKILL)
KILL ^TMP(TMPSUB,$JOB)
+15 ;Visit and Credit Stop Visits
+16 SET NODE=""
+17 FOR
SET NODE=$ORDER(^AUPNVSIT(VISITIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:1
+18 SET ^TMP(TMPSUB,$JOB,VISITIEN,"VST",VISITIEN,NODE)=^AUPNVSIT(VISITIEN,NODE)
End DoDot:1
+19 SET CSTPIEN=""
+20 FOR
SET CSTPIEN=$ORDER(^AUPNVSIT("AD",VISITIEN,CSTPIEN))
if CSTPIEN=""
QUIT
Begin DoDot:1
+21 IF "SC"'[$PIECE($GET(^AUPNVSIT(CSTPIEN,150)),"^",3)
QUIT
+22 SET NODE=""
+23 FOR
SET NODE=$ORDER(^AUPNVSIT(CSTPIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+24 SET ^TMP(TMPSUB,$JOB,VISITIEN,"CSTP",CSTPIEN,NODE)=^AUPNVSIT(CSTPIEN,NODE)
End DoDot:2
End DoDot:1
+25 ;
+26 ;V CPT
+27 SET VFIEN=""
+28 FOR
SET VFIEN=$ORDER(^AUPNVCPT("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+29 SET NODE=""
+30 FOR
SET NODE=$ORDER(^AUPNVCPT(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+31 IF NODE=801
QUIT
+32 ;Modifiers.
+33 IF NODE=1
Begin DoDot:3
+34 SET ^TMP(TMPSUB,$JOB,VISITIEN,"CPT",VFIEN,NODE,0)=^AUPNVCPT(VFIEN,NODE,0)
+35 SET IND=0
+36 FOR
SET IND=+$ORDER(^AUPNVCPT(VFIEN,NODE,IND))
if IND=0
QUIT
Begin DoDot:4
+37 SET ^TMP(TMPSUB,$JOB,VISITIEN,"CPT",VFIEN,NODE,IND,0)=^AUPNVCPT(VFIEN,NODE,IND,0)
End DoDot:4
End DoDot:3
+38 IF '$TEST
SET ^TMP(TMPSUB,$JOB,VISITIEN,"CPT",VFIEN,NODE)=^AUPNVCPT(VFIEN,NODE)
End DoDot:2
End DoDot:1
+39 ;
+40 ;V EXAM
+41 SET VFIEN=""
+42 FOR
SET VFIEN=$ORDER(^AUPNVXAM("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+43 SET NODE=""
+44 FOR
SET NODE=$ORDER(^AUPNVXAM(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+45 IF NODE=801
QUIT
+46 SET ^TMP(TMPSUB,$JOB,VISITIEN,"XAM",VFIEN,NODE)=^AUPNVXAM(VFIEN,NODE)
End DoDot:2
End DoDot:1
+47 ;
+48 ;V HF
+49 SET VFIEN=""
+50 FOR
SET VFIEN=$ORDER(^AUPNVHF("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+51 SET NODE=""
+52 FOR
SET NODE=$ORDER(^AUPNVHF(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+53 IF NODE=801
QUIT
+54 SET ^TMP(TMPSUB,$JOB,VISITIEN,"HF",VFIEN,NODE)=^AUPNVHF(VFIEN,NODE)
End DoDot:2
End DoDot:1
+55 ;
+56 ;V ICR
+57 SET VFIEN=""
+58 FOR
SET VFIEN=$ORDER(^AUPNVICR("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+59 SET NODE=""
+60 FOR
SET NODE=$ORDER(^AUPNVICR(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+61 IF NODE=801
QUIT
+62 SET ^TMP(TMPSUB,$JOB,VISITIEN,"ICR",VFIEN,NODE)=^AUPNVICR(VFIEN,NODE)
End DoDot:2
End DoDot:1
+63 ;
+64 ;V IMM
+65 SET VFIEN=""
+66 FOR
SET VFIEN=$ORDER(^AUPNVIMM("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+67 SET NODE=""
+68 FOR
SET NODE=$ORDER(^AUPNVIMM(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+69 IF NODE=801
QUIT
+70 ;Fields that are multiples.
+71 IF (NODE=2)!(NODE=3)!(NODE=11)
Begin DoDot:3
+72 SET ^TMP(TMPSUB,$JOB,VISITIEN,"IMM",VFIEN,NODE,0)=^AUPNVIMM(VFIEN,NODE,0)
+73 SET IND=0
+74 FOR
SET IND=+$ORDER(^AUPNVIMM(VFIEN,NODE,IND))
if IND=0
QUIT
Begin DoDot:4
+75 SET ^TMP(TMPSUB,$JOB,VISITIEN,"IMM",VFIEN,NODE,IND,0)=^AUPNVIMM(VFIEN,NODE,IND,0)
End DoDot:4
End DoDot:3
+76 IF '$TEST
SET ^TMP(TMPSUB,$JOB,VISITIEN,"IMM",VFIEN,NODE)=^AUPNVIMM(VFIEN,NODE)
End DoDot:2
End DoDot:1
+77 ;
+78 ;V PED
+79 SET VFIEN=""
+80 FOR
SET VFIEN=$ORDER(^AUPNVPED("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+81 SET NODE=""
+82 FOR
SET NODE=$ORDER(^AUPNVPED(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+83 IF NODE=801
QUIT
+84 SET ^TMP(TMPSUB,$JOB,VISITIEN,"PED",VFIEN,NODE)=^AUPNVPED(VFIEN,NODE)
End DoDot:2
End DoDot:1
+85 ;
+86 ;V POV
+87 SET VFIEN=""
+88 FOR
SET VFIEN=$ORDER(^AUPNVPOV("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+89 SET NODE=""
+90 FOR
SET NODE=$ORDER(^AUPNVPOV(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+91 IF NODE=801
QUIT
+92 SET ^TMP(TMPSUB,$JOB,VISITIEN,"POV",VFIEN,NODE)=^AUPNVPOV(VFIEN,NODE)
+93 ;Check for bad Provider Narrative Category pointer.
+94 IF (NODE=802)
IF (^AUPNVPOV(VFIEN,NODE)'>0)
SET ^TMP(TMPSUB,$JOB,VISITIEN,"POV",VFIEN,NODE)=""
End DoDot:2
End DoDot:1
+95 ;
+96 ;V PROVIDER
+97 SET VFIEN=""
+98 FOR
SET VFIEN=$ORDER(^AUPNVPRV("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+99 SET NODE=""
+100 FOR
SET NODE=$ORDER(^AUPNVPRV(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+101 IF NODE=801
QUIT
+102 SET ^TMP(TMPSUB,$JOB,VISITIEN,"PRV",VFIEN,NODE)=^AUPNVPRV(VFIEN,NODE)
+103 IF NODE=0
Begin DoDot:3
+104 SET TEMP=^AUPNVPRV(VFIEN,NODE)
SET PRV=$PIECE(TEMP,U,1)
SET PS=$PIECE(TEMP,U,4)
+105 ;Primary/Secondary is a required field but it is possible for it
+106 ;to be missing.
+107 IF PS=""
SET PS="M"
+108 SET PRVLIST(PRV,"CNT")=$GET(PRVLIST(PRV,"CNT"))+1
+109 SET PRVLIST(PRV,PS,"CNT")=$GET(PRVLIST(PRV,PS,"CNT"))+1
+110 SET PRVLIST(PRV,PS,PRVLIST(PRV,PS,"CNT"))=VFIEN
End DoDot:3
End DoDot:2
End DoDot:1
+111 ;Remove duplicates.
+112 SET PRV=""
+113 FOR
SET PRV=$ORDER(PRVLIST(PRV))
if PRV=""
QUIT
Begin DoDot:1
+114 IF PRVLIST(PRV,"CNT")=1
QUIT
+115 SET NUMM=+$GET(PRVLIST(PRV,"M","CNT"))
+116 SET NUMP=+$GET(PRVLIST(PRV,"P","CNT"))
+117 SET NUMS=+$GET(PRVLIST(PRV,"S","CNT"))
+118 ;Remove any entries that are missing the Primary/Secondary designation.
+119 IF NUMM>0
FOR IND=1:1:NUMM
SET VFIEN=PRVLIST(PRV,"M",IND)
KILL ^TMP(TMPSUB,$JOB,VISITIEN,"PRV",VFIEN)
+120 ;If this provider is listed as primary more than once, delete the other primaries.
+121 IF NUMP>1
Begin DoDot:2
+122 FOR IND=2:1:NUMP
SET VFIEN=PRVLIST(PRV,"P",IND)
KILL ^TMP(TMPSUB,$JOB,VISITIEN,"PRV",VFIEN)
+123 ;If this provider is a primary, delete all its secondaries and missing.
End DoDot:2
+124 IF NUMP>0
Begin DoDot:2
+125 FOR IND=1:1:NUMS
SET VFIEN=PRVLIST(PRV,"S",IND)
KILL ^TMP(TMPSUB,$JOB,VISITIEN,"PRV",VFIEN)
+126 SET NUMS=0
End DoDot:2
+127 ;If this provider is not primary, only keep the first secondary.
+128 IF NUMS>1
Begin DoDot:2
+129 FOR IND=2:1:NUMS
Begin DoDot:3
+130 SET VFIEN=PRVLIST(PRV,"S",IND)
+131 KILL ^TMP(TMPSUB,$JOB,VISITIEN,"PRV",VFIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+132 ;
+133 ;V SC
+134 SET VFIEN=""
+135 FOR
SET VFIEN=$ORDER(^AUPNVSC("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+136 SET NODE=""
+137 FOR
SET NODE=$ORDER(^AUPNVSC(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+138 IF NODE=801
QUIT
+139 SET ^TMP(TMPSUB,$JOB,VISITIEN,"SC",VFIEN,NODE)=^AUPNVSC(VFIEN,NODE)
End DoDot:2
End DoDot:1
+140 ;
+141 ;V SKIN
+142 SET VFIEN=""
+143 FOR
SET VFIEN=$ORDER(^AUPNVSK("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+144 SET NODE=""
+145 FOR
SET NODE=$ORDER(^AUPNVSK(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+146 IF NODE=801
QUIT
+147 SET ^TMP(TMPSUB,$JOB,VISITIEN,"SK",VFIEN,NODE)=^AUPNVSK(VFIEN,NODE)
End DoDot:2
End DoDot:1
+148 ;
+149 ;V TRT
+150 SET VFIEN=""
+151 FOR
SET VFIEN=$ORDER(^AUPNVTRT("AD",VISITIEN,VFIEN))
if VFIEN=""
QUIT
Begin DoDot:1
+152 SET NODE=""
+153 FOR
SET NODE=$ORDER(^AUPNVTRT(VFIEN,NODE))
if (NODE'=+NODE)
QUIT
Begin DoDot:2
+154 IF NODE=801
QUIT
+155 SET ^TMP(TMPSUB,$JOB,VISITIEN,"TRT",VFIEN,NODE)=^AUPNVTRT(VFIEN,NODE)
End DoDot:2
End DoDot:1
+156 QUIT
+157 ;
