- 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**;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
- S (PXC,PXCC,PXCCC,PXCCCC)=""
- 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 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 ""
- 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**;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
- +3 SET (PXC,PXCC,PXCCC,PXCCCC)=""
- +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 SET PXCCC=$EXTRACT($PIECE($GET(^ICPT(PXC,0)),"^",2),1,30)
- +26 SET PXCCCC=$PIECE($GET(^ICPT(PXC,0)),"^",1)
- +27 SET ENTRY="CPT "_$GET(PXCCCC)_" - "_$GET(PXCCC)_" = "_$GET(PXCC)_" TIMES"
- +28 WRITE $$RE^PXQUTL(ENTRY)
- End DoDot:2
- End DoDot:1
- +29 DO CPT
- +30 KILL PXQSDV,DATE
- +31 WRITE $$RE^PXQUTL(" ")
- +32 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 ""
