PXQUTL ;ISL/JVS - FUNCTION CALLS FOR DEBUGGING UTILITIES;8/29/96 10:34 ;3/26/97 09:25
;;1.0;PCE PATIENT CARE ENCOUNTER;**4,14,29,121**;Aug 12, 1996
;
LCFLE() ;--LOCATION FILES
N LOCCNT,IHSCNT
;--COUNT FROM LOCATION FILE 4
S LOCCNT=$P($G(^DIC(4,0)),"^",3)
;--COUNT FROM IHS LOCATION FILE 9999999.06
S IHSCNT=$P($G(^AUTTLOC(0)),"^",3)
Q LOCCNT_"^"_IHSCNT
;
PTFLE() ;--PATIENT FILES
N DPTCNT,IHSCNT
;--COUNT FROM DPT FILE 2
S DPTCNT=$P($G(^DPT(0)),"^",3)
;--COUNT FORM AUPNPAT FILE 9000010
S IHSCNT=$P($G(^AUPNPAT(0)),"^",3)
Q DPTCNT_"^"_IHSCNT
;
RE(ENTRY) ;--RECORD ENTRY TO BE PRINTED
Q:$G(ENTRY)="" ""
I $L(ENTRY)>80 S ENTRY=$E(ENTRY,1,78)_""""
S PXQRECI=PXQRECI+1
S ^TMP("PXQRECORD",$J,PXQRECI,ENTRY)=""
Q ""
;
READ ;--READ
N VAR,I,ANS,DX,DY
W !,"**************************************************************"
S (DX,DY)=0 X ^%ZOSF("XY")
S I=0
I '$G(CNT) S CNT=0
F S I=$O(^TMP("PXQRECORD",$J,I)) Q:I="" D
.S VAR=$O(^TMP("PXQRECORD",$J,I,0))
.;--NEW 3/25/97
.I VAR["^" S VAR=$TR(VAR,"?!","11")
.;--END OF NEW
.I VAR'["?"&(VAR'["!") W !,$O(^TMP("PXQRECORD",$J,I,0))
.I VAR["?"!(VAR["!") W !,@$O(^TMP("PXQRECORD",$J,I,0))
.S CNT=CNT+1
.;I $Y>(IOSL-2) D
.I CNT>(IOSL-4) S CNT=0 D
..I IOST["C-" R !,"ENTER to continue",ANS:DTIME
..I $G(ANS)="^" S I=9999999999999
..S (DX,DY)=0 X ^%ZOSF("XY")
K ^TMP("PXQRECORD",$J),PXQPRM
I IOST["C-",$G(ANS)'="^" R !," END OF DISPLAY",ANS:DTIME
;I IOST["C-",$G(ANS)'="^" W !," END OF DISPLAY"
Q
ASKPAT() ;Ask user for a patient
;DIC on file 9000001
N DIR,DIC,Y,X,DA
S DIR(0)="PO^9000001:AEMQ"
S DIR("A")="Patient Name"
D ^DIR
Q $S(+Y>0:+Y,1:-1)
;
;
ASKNUM() ;Ask user for a VISIT
;DIC on file 9000010
N DIR,DIC,Y,X,DA
I $D(^DISV(DUZ,"PXQREP3")) S DIR("B")=$G(^DISV(DUZ,"PXQREP3"))
S DIR(0)="P^9000010:AEMQ"
S DIR("A")="Enter VISIT (UNIQUE ID or `1239)"
D ^DIR
Q $S(+Y>0:+Y,1:-1)
;
ASKNUM1() ;Ask user for a VISIT
;DIC on file 9000010
N DIC,Y,X,DA
I $D(^DISV(DUZ,"PXQREP3")) S DIR("B")=$G(^DISV(DUZ,"PXQREP3"))
S DIR(0)="P^9000010:AEMQ"
S DIR("A")="Enter VISIT (UNIQUE ID or `1239)"
D ^DIR
Q $S(+Y>0:+Y,1:-1)
;
ASKENC() ;Ask user for a ENCOUNTER
;DIC on file 409.68
N DIR,DIC,Y,X,DA
S DIR(0)="P^409.68:AEMQ"
S DIR("A")="Enter ENCOUNTER (`2344)"
D ^DIR
Q $S(+Y>0:+Y,1:-1)
;
;
SOR(IEN) ;--SOURCE IF SELECTED FROM MENU
Q:'$G(IEN) ""
W $$RE^PXQUTL("!")
W $$RE^PXQUTL("----------------VISIT "_IEN_"---SOURCES-------------")
;
;
;
S DATEC=$P($G(^AUPNVSIT(IEN,0)),"^",2) D
.S Y=DATEC D DD^%DT S DATEC=Y
W $$RE^PXQUTL("?5,""CREATED : ""_DATEC")
;
;
S DATEE=$P($G(^AUPNVSIT(IEN,0)),"^",13) D
.S Y=DATEE D DD^%DT S DATEE=Y
W $$RE^PXQUTL("?5,""EDITED : ""_DATEE")
;
;
S USER=$S(+$P($G(^AUPNVSIT(IEN,0)),"^",23)>0:$P(^VA(200,+$P($G(^AUPNVSIT(IEN,0)),"^",23),0),"^",1),1:"")
W $$RE^PXQUTL("?5,""USER : ""_USER")
;
;
I $D(^DIC(19,+$P($G(^AUPNVSIT(IEN,0)),"^",24),0)) D
.S OPTION=$S(+$P($G(^AUPNVSIT(IEN,0)),"^",24)>0:$P(^DIC(19,+$P($G(^AUPNVSIT(IEN,0)),"^",24),0),"^",2),1:"")
.W $$RE^PXQUTL("?5,""OPTION : ""_OPTION")
;
I $D(^ORD(101,+$P($G(^AUPNVSIT(IEN,0)),"^",25),0)) D
.S PROTOCOL=$S(+$P($G(^AUPNVSIT(IEN,0)),"^",25)>0:$P(^ORD(101,+$P($G(^AUPNVSIT(IEN,0)),"^",25),0),"^",2),1:"")
.W $$RE^PXQUTL("?5,""PROTOCOL: ""_PROTOCOL")
;
;
I $D(^DIC(9.4,+$P($G(^AUPNVSIT(IEN,812)),"^",2),0)) D
.S PACKAGE=$S(+$P($G(^AUPNVSIT(IEN,812)),"^",2)>0:$P(^DIC(9.4,+$P($G(^AUPNVSIT(IEN,812)),"^",2),0),"^",1),1:"")
.W $$RE^PXQUTL("?5,""PACKAGE : ""_PACKAGE")
;
;
I $P($G(^AUPNVSIT(IEN,812)),"^",3) D
.I $D(^PX(839.7,$P($G(^AUPNVSIT(IEN,812)),"^",3),0)) D
..S SOURCE=$S(+$P($G(^AUPNVSIT(IEN,812)),"^",3)>0:$P(^PX(839.7,+$P($G(^AUPNVSIT(IEN,812)),"^",3),0),"^",1),1:"")
..W $$RE^PXQUTL("?5,""SOURCE : ""_SOURCE")
;
W $$RE^PXQUTL("______________________________________________________")
Q ""
;
SDV ;--IF AN APPOINTMENT ON THAT DAY
N JUNK,PATIENT,ENTRY,CNT,CS,DAY,DAY2,ERR,POINT,STOP
N PXC,PXCC,PXCCC,PXCCCC,ICPTSTR
S (PXC,PXCC,PXCCC,PXCCCC,ICPTSTR)=""
I $G(BROKEN),'$G(DFN),'$G(PATIENT),'$G(DATE) Q
I $G(DFN) S PATIENT=DFN
I '$G(DFN) S (PATIENT,DFN)=$P(^AUPNVSIT(IEN,0),"^",5)
Q:'$G(PATIENT)
I '$G(BROKEN) S DATE=$P(^AUPNVSIT(IEN,0),"^",1)
S CNT=0
S DAY=$P(DATE,".",1)
F S DAY=$O(^SDV("C",PATIENT,DAY)) Q:DAY'[$P(DATE,".",1) S CNT=CNT+1 D
.W $$RE^PXQUTL("!")
.W !
.S REF="^SDV(DAY)"
.F S REF=$Q(@REF) Q:REF'[DAY S DAY2=$P($P(REF,"(",2),",") I '$G(ERR),$P($G(^SDV(DAY2,0)),"^",2)=PATIENT,REF'["""CS"",""B""," S ENTRY=REF_" = "_@REF W $$RE^PXQUTL(ENTRY) I REF["""PR""" D CPT2
.;---
.W $$RE^PXQUTL(" ")
.S CS=0 F S CS=$O(^SDV(DAY2,"CS",CS)) Q:CS'>0 D
..Q:$P($G(^SDV(DAY2,0)),"^",2)'=PATIENT
..S POINT=$P($G(^SDV(DAY2,"CS",CS,0)),"^",1)
..S STOP=$G(^DIC(40.7,POINT,0))
..W $$RE^PXQUTL("STOP CODE "_POINT_" = "_STOP)
.S PXC=0 F S PXC=$O(PXQSDV(PXC)) Q:PXC="" Q:'$D(PXQSDV) D
..S PXCC=$O(PXQSDV(PXC,0))
..;S PXCCC=$E($P($G(^ICPT(PXC,0)),"^",2),1,30)
..;S PXCCCC=$P($G(^ICPT(PXC,0)),"^",1)
..S ICPTSTR=$$CPT^ICPTCOD(PXC,DAY)
..S PXCCC=$E($P(ICPTSTR,"^",3),1,30)
..S PXCCCC=$P(ICPTSTR,"^",2)
..S ENTRY="CPT "_$G(PXCCCC)_" - "_$G(PXCCC)_" = "_$G(PXCC)_" TIMES"
..W $$RE^PXQUTL(ENTRY)
D CPT
K PXQSDV,DATE
W $$RE^PXQUTL(" ")
Q
CPT ;--PROCEDURES
I $D(^AUPNVCPT("AD",VISIT)),CNT=0 W $$RE^PXQUTL("THERE ARE PROCEDURES IN PCE BUT NO RECORD IN SCHEDULING **")
Q
CPT2 ;--COUNT PROCEDURES
N PXQC,PXQQ
S PXQQ=0
F I=1:1:5 S PXQC=$P(@REF,"^",I) I PXQC]"" D
.I $D(PXQSDV(PXQC)) S PXQQ=$O(PXQSDV(PXQC,0))
.K PXQSDV(PXQC,PXQQ)
.S PXQSDV(PXQC,(PXQQ+1))=""
.S PXQQ=0
Q
;
;
EXP(ROOT,IEN) ;---EXPAND ENTRIES
N I,REF,REF2,ENTRY
I ROOT["SCE",$P($G(^SCE(IEN,0)),"^",6)']"",$G(PXQPRM)=1 D
.W $$RE^PXQUTL(" ~~~~ERROR~~~")
.W $$RE^PXQUTL("** There is more Than 1 PARENT OUTPATIENT ENCOUNTER pointing to the same VISIT**")
.W $$RE^PXQUTL(" ")
I ROOT["SCE"&($P($G(^SCE(IEN,0)),"^",6)']"") S PXQPRM=1
I $G(BROKEN),ROOT["AUPNVCPT" S (DFN,PATIENT)=$P($G(^AUPNVCPT(IEN,0)),"^",2)
I $G(BROKEN),ROOT["SCE",'$G(DATE) S DATE=$P($G(^SCE(IEN,0)),"^",1),(DFN,PATIENT)=$P($G(^SCE(IEN,0)),"^",2)
S REF=$P(ROOT,"""",1)_IEN_")"
S REF2=$P(ROOT,"""",1)_IEN
F S REF=$Q(@REF) Q:REF'[REF2 S ENTRY=REF_" = "_@REF W $$RE^PXQUTL($G(ENTRY))
W $$RE^PXQUTL(" ")
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXQUTL 6415 printed Apr 09, 2024@21:30:42 Page 2
PXQUTL ;ISL/JVS - FUNCTION CALLS FOR DEBUGGING UTILITIES;8/29/96 10:34 ;3/26/97 09:25
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**4,14,29,121**;Aug 12, 1996
+2 ;
LCFLE() ;--LOCATION FILES
+1 NEW LOCCNT,IHSCNT
+2 ;--COUNT FROM LOCATION FILE 4
+3 SET LOCCNT=$PIECE($GET(^DIC(4,0)),"^",3)
+4 ;--COUNT FROM IHS LOCATION FILE 9999999.06
+5 SET IHSCNT=$PIECE($GET(^AUTTLOC(0)),"^",3)
+6 QUIT LOCCNT_"^"_IHSCNT
+7 ;
PTFLE() ;--PATIENT FILES
+1 NEW DPTCNT,IHSCNT
+2 ;--COUNT FROM DPT FILE 2
+3 SET DPTCNT=$PIECE($GET(^DPT(0)),"^",3)
+4 ;--COUNT FORM AUPNPAT FILE 9000010
+5 SET IHSCNT=$PIECE($GET(^AUPNPAT(0)),"^",3)
+6 QUIT DPTCNT_"^"_IHSCNT
+7 ;
RE(ENTRY) ;--RECORD ENTRY TO BE PRINTED
+1 if $GET(ENTRY)=""
QUIT ""
+2 IF $LENGTH(ENTRY)>80
SET ENTRY=$EXTRACT(ENTRY,1,78)_""""
+3 SET PXQRECI=PXQRECI+1
+4 SET ^TMP("PXQRECORD",$JOB,PXQRECI,ENTRY)=""
+5 QUIT ""
+6 ;
READ ;--READ
+1 NEW VAR,I,ANS,DX,DY
+2 WRITE !,"**************************************************************"
+3 SET (DX,DY)=0
XECUTE ^%ZOSF("XY")
+4 SET I=0
+5 IF '$GET(CNT)
SET CNT=0
+6 FOR
SET I=$ORDER(^TMP("PXQRECORD",$JOB,I))
if I=""
QUIT
Begin DoDot:1
+7 SET VAR=$ORDER(^TMP("PXQRECORD",$JOB,I,0))
+8 ;--NEW 3/25/97
+9 IF VAR["^"
SET VAR=$TRANSLATE(VAR,"?!","11")
+10 ;--END OF NEW
+11 IF VAR'["?"&(VAR'["!")
WRITE !,$ORDER(^TMP("PXQRECORD",$JOB,I,0))
+12 IF VAR["?"!(VAR["!")
WRITE !,@$ORDER(^TMP("PXQRECORD",$JOB,I,0))
+13 SET CNT=CNT+1
+14 ;I $Y>(IOSL-2) D
+15 IF CNT>(IOSL-4)
SET CNT=0
Begin DoDot:2
+16 IF IOST["C-"
READ !,"ENTER to continue",ANS:DTIME
+17 IF $GET(ANS)="^"
SET I=9999999999999
+18 SET (DX,DY)=0
XECUTE ^%ZOSF("XY")
End DoDot:2
End DoDot:1
+19 KILL ^TMP("PXQRECORD",$JOB),PXQPRM
+20 IF IOST["C-"
IF $GET(ANS)'="^"
READ !," END OF DISPLAY",ANS:DTIME
+21 ;I IOST["C-",$G(ANS)'="^" W !," END OF DISPLAY"
+22 QUIT
ASKPAT() ;Ask user for a patient
+1 ;DIC on file 9000001
+2 NEW DIR,DIC,Y,X,DA
+3 SET DIR(0)="PO^9000001:AEMQ"
+4 SET DIR("A")="Patient Name"
+5 DO ^DIR
+6 QUIT $SELECT(+Y>0:+Y,1:-1)
+7 ;
+8 ;
ASKNUM() ;Ask user for a VISIT
+1 ;DIC on file 9000010
+2 NEW DIR,DIC,Y,X,DA
+3 IF $DATA(^DISV(DUZ,"PXQREP3"))
SET DIR("B")=$GET(^DISV(DUZ,"PXQREP3"))
+4 SET DIR(0)="P^9000010:AEMQ"
+5 SET DIR("A")="Enter VISIT (UNIQUE ID or `1239)"
+6 DO ^DIR
+7 QUIT $SELECT(+Y>0:+Y,1:-1)
+8 ;
ASKNUM1() ;Ask user for a VISIT
+1 ;DIC on file 9000010
+2 NEW DIC,Y,X,DA
+3 IF $DATA(^DISV(DUZ,"PXQREP3"))
SET DIR("B")=$GET(^DISV(DUZ,"PXQREP3"))
+4 SET DIR(0)="P^9000010:AEMQ"
+5 SET DIR("A")="Enter VISIT (UNIQUE ID or `1239)"
+6 DO ^DIR
+7 QUIT $SELECT(+Y>0:+Y,1:-1)
+8 ;
ASKENC() ;Ask user for a ENCOUNTER
+1 ;DIC on file 409.68
+2 NEW DIR,DIC,Y,X,DA
+3 SET DIR(0)="P^409.68:AEMQ"
+4 SET DIR("A")="Enter ENCOUNTER (`2344)"
+5 DO ^DIR
+6 QUIT $SELECT(+Y>0:+Y,1:-1)
+7 ;
+8 ;
SOR(IEN) ;--SOURCE IF SELECTED FROM MENU
+1 if '$GET(IEN)
QUIT ""
+2 WRITE $$RE^PXQUTL("!")
+3 WRITE $$RE^PXQUTL("----------------VISIT "_IEN_"---SOURCES-------------")
+4 ;
+5 ;
+6 ;
+7 SET DATEC=$PIECE($GET(^AUPNVSIT(IEN,0)),"^",2)
Begin DoDot:1
+8 SET Y=DATEC
DO DD^%DT
SET DATEC=Y
End DoDot:1
+9 WRITE $$RE^PXQUTL("?5,""CREATED : ""_DATEC")
+10 ;
+11 ;
+12 SET DATEE=$PIECE($GET(^AUPNVSIT(IEN,0)),"^",13)
Begin DoDot:1
+13 SET Y=DATEE
DO DD^%DT
SET DATEE=Y
End DoDot:1
+14 WRITE $$RE^PXQUTL("?5,""EDITED : ""_DATEE")
+15 ;
+16 ;
+17 SET USER=$SELECT(+$PIECE($GET(^AUPNVSIT(IEN,0)),"^",23)>0:$PIECE(^VA(200,+$PIECE($GET(^AUPNVSIT(IEN,0)),"^",23),0),"^",1),1:"")
+18 WRITE $$RE^PXQUTL("?5,""USER : ""_USER")
+19 ;
+20 ;
+21 IF $DATA(^DIC(19,+$PIECE($GET(^AUPNVSIT(IEN,0)),"^",24),0))
Begin DoDot:1
+22 SET OPTION=$SELECT(+$PIECE($GET(^AUPNVSIT(IEN,0)),"^",24)>0:$PIECE(^DIC(19,+$PIECE($GET(^AUPNVSIT(IEN,0)),"^",24),0),"^",2),1:"")
+23 WRITE $$RE^PXQUTL("?5,""OPTION : ""_OPTION")
End DoDot:1
+24 ;
+25 IF $DATA(^ORD(101,+$PIECE($GET(^AUPNVSIT(IEN,0)),"^",25),0))
Begin DoDot:1
+26 SET PROTOCOL=$SELECT(+$PIECE($GET(^AUPNVSIT(IEN,0)),"^",25)>0:$PIECE(^ORD(101,+$PIECE($GET(^AUPNVSIT(IEN,0)),"^",25),0),"^",2),1:"")
+27 WRITE $$RE^PXQUTL("?5,""PROTOCOL: ""_PROTOCOL")
End DoDot:1
+28 ;
+29 ;
+30 IF $DATA(^DIC(9.4,+$PIECE($GET(^AUPNVSIT(IEN,812)),"^",2),0))
Begin DoDot:1
+31 SET PACKAGE=$SELECT(+$PIECE($GET(^AUPNVSIT(IEN,812)),"^",2)>0:$PIECE(^DIC(9.4,+$PIECE($GET(^AUPNVSIT(IEN,812)),"^",2),0),"^",1),1:"")
+32 WRITE $$RE^PXQUTL("?5,""PACKAGE : ""_PACKAGE")
End DoDot:1
+33 ;
+34 ;
+35 IF $PIECE($GET(^AUPNVSIT(IEN,812)),"^",3)
Begin DoDot:1
+36 IF $DATA(^PX(839.7,$PIECE($GET(^AUPNVSIT(IEN,812)),"^",3),0))
Begin DoDot:2
+37 SET SOURCE=$SELECT(+$PIECE($GET(^AUPNVSIT(IEN,812)),"^",3)>0:$PIECE(^PX(839.7,+$PIECE($GET(^AUPNVSIT(IEN,812)),"^",3),0),"^",1),1:"")
+38 WRITE $$RE^PXQUTL("?5,""SOURCE : ""_SOURCE")
End DoDot:2
End DoDot:1
+39 ;
+40 WRITE $$RE^PXQUTL("______________________________________________________")
+41 QUIT ""
+42 ;
SDV ;--IF AN APPOINTMENT ON THAT DAY
+1 NEW JUNK,PATIENT,ENTRY,CNT,CS,DAY,DAY2,ERR,POINT,STOP
+2 NEW PXC,PXCC,PXCCC,PXCCCC,ICPTSTR
+3 SET (PXC,PXCC,PXCCC,PXCCCC,ICPTSTR)=""
+4 IF $GET(BROKEN)
IF '$GET(DFN)
IF '$GET(PATIENT)
IF '$GET(DATE)
QUIT
+5 IF $GET(DFN)
SET PATIENT=DFN
+6 IF '$GET(DFN)
SET (PATIENT,DFN)=$PIECE(^AUPNVSIT(IEN,0),"^",5)
+7 if '$GET(PATIENT)
QUIT
+8 IF '$GET(BROKEN)
SET DATE=$PIECE(^AUPNVSIT(IEN,0),"^",1)
+9 SET CNT=0
+10 SET DAY=$PIECE(DATE,".",1)
+11 FOR
SET DAY=$ORDER(^SDV("C",PATIENT,DAY))
if DAY'[$PIECE(DATE,".",1)
QUIT
SET CNT=CNT+1
Begin DoDot:1
+12 WRITE $$RE^PXQUTL("!")
+13 WRITE !
+14 SET REF="^SDV(DAY)"
+15 FOR
SET REF=$QUERY(@REF)
if REF'[DAY
QUIT
SET DAY2=$PIECE($PIECE(REF,"(",2),",")
IF '$GET(ERR)
IF $PIECE($GET(^SDV(DAY2,0)),"^",2)=PATIENT
IF REF'["""CS"",""B"","
SET ENTRY=REF_" = "_@REF
WRITE $$RE^PXQUTL(ENTRY)
IF REF["""PR"""
DO CPT2
+16 ;---
+17 WRITE $$RE^PXQUTL(" ")
+18 SET CS=0
FOR
SET CS=$ORDER(^SDV(DAY2,"CS",CS))
if CS'>0
QUIT
Begin DoDot:2
+19 if $PIECE($GET(^SDV(DAY2,0)),"^",2)'=PATIENT
QUIT
+20 SET POINT=$PIECE($GET(^SDV(DAY2,"CS",CS,0)),"^",1)
+21 SET STOP=$GET(^DIC(40.7,POINT,0))
+22 WRITE $$RE^PXQUTL("STOP CODE "_POINT_" = "_STOP)
End DoDot:2
+23 SET PXC=0
FOR
SET PXC=$ORDER(PXQSDV(PXC))
if PXC=""
QUIT
if '$DATA(PXQSDV)
QUIT
Begin DoDot:2
+24 SET PXCC=$ORDER(PXQSDV(PXC,0))
+25 ;S PXCCC=$E($P($G(^ICPT(PXC,0)),"^",2),1,30)
+26 ;S PXCCCC=$P($G(^ICPT(PXC,0)),"^",1)
+27 SET ICPTSTR=$$CPT^ICPTCOD(PXC,DAY)
+28 SET PXCCC=$EXTRACT($PIECE(ICPTSTR,"^",3),1,30)
+29 SET PXCCCC=$PIECE(ICPTSTR,"^",2)
+30 SET ENTRY="CPT "_$GET(PXCCCC)_" - "_$GET(PXCCC)_" = "_$GET(PXCC)_" TIMES"
+31 WRITE $$RE^PXQUTL(ENTRY)
End DoDot:2
End DoDot:1
+32 DO CPT
+33 KILL PXQSDV,DATE
+34 WRITE $$RE^PXQUTL(" ")
+35 QUIT
CPT ;--PROCEDURES
+1 IF $DATA(^AUPNVCPT("AD",VISIT))
IF CNT=0
WRITE $$RE^PXQUTL("THERE ARE PROCEDURES IN PCE BUT NO RECORD IN SCHEDULING **")
+2 QUIT
CPT2 ;--COUNT PROCEDURES
+1 NEW PXQC,PXQQ
+2 SET PXQQ=0
+3 FOR I=1:1:5
SET PXQC=$PIECE(@REF,"^",I)
IF PXQC]""
Begin DoDot:1
+4 IF $DATA(PXQSDV(PXQC))
SET PXQQ=$ORDER(PXQSDV(PXQC,0))
+5 KILL PXQSDV(PXQC,PXQQ)
+6 SET PXQSDV(PXQC,(PXQQ+1))=""
+7 SET PXQQ=0
End DoDot:1
+8 QUIT
+9 ;
+10 ;
EXP(ROOT,IEN) ;---EXPAND ENTRIES
+1 NEW I,REF,REF2,ENTRY
+2 IF ROOT["SCE"
IF $PIECE($GET(^SCE(IEN,0)),"^",6)']""
IF $GET(PXQPRM)=1
Begin DoDot:1
+3 WRITE $$RE^PXQUTL(" ~~~~ERROR~~~")
+4 WRITE $$RE^PXQUTL("** There is more Than 1 PARENT OUTPATIENT ENCOUNTER pointing to the same VISIT**")
+5 WRITE $$RE^PXQUTL(" ")
End DoDot:1
+6 IF ROOT["SCE"&($PIECE($GET(^SCE(IEN,0)),"^",6)']"")
SET PXQPRM=1
+7 IF $GET(BROKEN)
IF ROOT["AUPNVCPT"
SET (DFN,PATIENT)=$PIECE($GET(^AUPNVCPT(IEN,0)),"^",2)
+8 IF $GET(BROKEN)
IF ROOT["SCE"
IF '$GET(DATE)
SET DATE=$PIECE($GET(^SCE(IEN,0)),"^",1)
SET (DFN,PATIENT)=$PIECE($GET(^SCE(IEN,0)),"^",2)
+9 SET REF=$PIECE(ROOT,"""",1)_IEN_")"
+10 SET REF2=$PIECE(ROOT,"""",1)_IEN
+11 FOR
SET REF=$QUERY(@REF)
if REF'[REF2
QUIT
SET ENTRY=REF_" = "_@REF
WRITE $$RE^PXQUTL($GET(ENTRY))
+12 WRITE $$RE^PXQUTL(" ")
+13 QUIT ""
