SROPCEU ;BIR/ADM-List/Refile Not Transmitted Outpatient Encounters ; [ 09/22/98 11:41 AM ]
;;3.0; Surgery ;**69,77,50**;24 Jun 93
S (SRFLG,SRSORT,SRSOUT)=0,SRSPEC=""
W @IOF,!,?13,"Outpatient Surgery Encounters Not Transmitted to NPCD",!!!,"Surgical cases filed with PCE that have no Scheduling appointment status",!,"or that have an appointment status of ACTION REQUIRED or NON-COUNT indicate"
W !,"surgical encounters that have not transmitted to the National Patient",!,"Care Database. This option is intended as a tool to identify these",!,"encounters and, after taking appropriate corrective measures, to"
W !,"reinitiate the encounter transmission process.",!!
ASK K DIR S DIR("A",1)=" 1. Print list of cases.",DIR("A",2)=" 2. Print total number of cases only.",DIR("A",3)=" 3. Re-file cases in PCE.",DIR("A",4)="",DIR("A")="Select Number: ",DIR("B")=1
S DIR("?",1)="Enter 1 to print a list of surgical cases and/or non-OR procedures that are",DIR("?",2)="filed in PCE, but have no Scheduling appointment status or have an"
S DIR("?",3)="an appointment status of ACTION REQUIRED or NON-COUNT.",DIR("?",4)="",DIR("?",5)="Enter 2 to print the total number of cases only with no list."
S DIR("?",6)="",DIR("?",7)="Enter 3 to re-file in PCE surgical cases and/or non-OR procedures that are"
S DIR("?",8)="already filed, but have no Scheduling appointment status or have an",DIR("?")="appointment status of ACTION REQUIRED or NON-COUNT."
S DIR(0)="NA^1:3:0" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 D END Q
S SRSEL=Y W !!
S DIR("A",1)=$S(SRSEL=1:"Print the list for",SRSEL=2:"Print totals for",1:"Re-file")_" the following.",DIR("A",2)="",DIR("A",3)=" 1. O.R. Surgical Procedures",DIR("A",4)=" 2. Non-O.R. Procedures"
S DIR("A",5)=" 3. Both O.R. Surgical Procedures and Non-O.R. Procedures (All Specialties)",DIR("A",6)="",DIR("A")="Select Number (1, 2 or 3): ",DIR("B")="1"
S DIR(0)="NA^1:3:0" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 D END Q
S SRFLG=Y I SRFLG=1 D SPEC I SRSOUT D END Q
I SRFLG=2 D MSP I SRSOUT D END Q
I SRFLG=3 D ALL I SRSOUT D END Q
DATE D DATE^SROUTL(.SDATE,.EDATE,.SRSOUT) G:SRSOUT END
I SRSEL'=3 W ! K %ZIS,IOP,IO("Q"),POP D I SRSOUT D END Q
.S %ZIS("A")="Print report on which printer ? ",%ZIS="Q" D ^%ZIS I POP S SRSOUT=1
.I $D(IO("Q")) K IO("Q") D ZT D ^%ZTLOAD S SRSOUT=1
I SRSEL=3 D ZT S ZTIO="" D ^%ZTLOAD W:$G(ZTSK) !," (Task #"_ZTSK_")" D END Q
EN D TMP I SRSEL'=3 D ^SROPCEU0
I SRSEL=3 D REFILE^SROPCEU0
END W:$E(IOST)="P" @IOF K ^TMP("SR69",$J),^TMP("SRSP",$J) I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
I 'SRSOUT,$E(IOST)'="P" W !!,"Press RETURN to continue " R X:DTIME
D ^%ZISC K SR12,SRDIV,SRDX,SRENC,SRFCPT,SRFICD,SRFRTO,SRINOUT,SRPARAM,SRPODX,SRQCPT,SRQICD,SRRPT,SRSEL,SRSORT,SRSPS,SRSR,SRTN,SRUCPT,SRUICD D ^SRSKILL W @IOF
Q
ZT S ZTDESC=$S(SRSEL=2:"Re-file",1:"Report of")_" Untransmitted Surgery Oupatient Encounters"
S (ZTSAVE("EDATE"),ZTSAVE("SDATE"),ZTSAVE("SRSITE*"),ZTSAVE("SRSPEC*"),ZTSAVE("SRFLG"),ZTSAVE("SRSEL"),ZTSAVE("SRSORT"))=""
S ZTRTN="EN^SROPCEU"
Q
SPEC W ! S DIR("?",1)="Enter YES if you would like "_$S(SRSEL=3:"re-filing",1:"the report printed")_" for all Surgical Specialties",DIR("?")="or enter NO to select a specific specialty."
S DIR("A")="Do you want "_$S(SRSEL=3:"re-filing",1:"the report")_" for all Surgical Specialties ? ",DIR("B")="YES",DIR(0)="YA" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
I Y D ALL Q
I 'Y W ! K DIC S DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Select Surgical Specialty: ",DIC("S")="I '$P(^(0),""^"",3)" D ^DIC K DIC S:Y<0 SRSOUT=1 Q:Y<0 S SRSPEC=+Y,SRSPECN=$P(Y(0),"^")
Q
ALL Q:SRSEL=3 W ! I SRSEL=1 D
.S DIR("?",1)="Enter YES if you would like the report to be sorted by specialty. Enter NO",DIR("?")="if you would like all specialties combined and sorted by case number.",DIR("A")="Do you want the report sorted by Specialty ? "
I SRSEL=2 D
.S DIR("?",1)="Enter YES if you would like the report to give totals for each specialty.",DIR("?")="Enter NO if you would like totals for all specialties combined.",DIR("A")="Do you want totals separated by Specialty ? "
S DIR("B")="YES",DIR(0)="YA" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
I Y S SRSORT=1
Q
MSP W ! S DIR("?",1)="Enter YES if you would like "_$S(SRSEL=3:"re-filing",1:"the report printed")_" for all Medical Specialties",DIR("?")="or enter NO to select a specific specialty."
S DIR("A")="Do you want "_$S(SRSEL=3:"re-filing",1:"the report")_" for all Medical Specialties ? ",DIR("B")="YES",DIR(0)="YA" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
I Y D ALL Q
I 'Y W ! K DIC S DIC=723,DIC(0)="QEAMZ",DIC("A")="Select Medical Specialty: " D ^DIC K DIC S:Y<0 SRSOUT=1 Q:Y<0 S SRSPEC=+Y,SRSPECN=$P(Y(0),"^")
Q
TMP ; identify cases with not transmitted encounters
N SRVSIT S SRSDT=SDATE-.0001,SRSEDT=EDATE+.9999 K ^TMP("SR69",$J),^TMP("SRSP",$J) S:SRSORT ^TMP("SRSP",$J,0)="0^0^0^0" S SRCNT=0 F I=0,12,14 S SRCNT(I)=0
F S SRSDT=$O(^SRF("AC",SRSDT)) Q:'SRSDT!(SRSDT>SRSEDT) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN I $D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN) D
.S SR=^SRF(SRTN,0),SR12=$P(SR,"^",12),SRVSIT=$P(SR,"^",15) Q:'SRVSIT!(SR12'="O")
.S SRNON=0 I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SRNON=1
.I SRFLG=1,SRNON Q
.I SRFLG=2,'SRNON Q
.S SRSS=$S('SRNON:$P(SR,"^",4),1:$P(^SRF(SRTN,"NON"),"^",8)) I SRSPEC,SRSPEC'=SRSS Q
.I 'SRNON S SRSS="1;;"_$P(^SRO(137.45,SRSS,0),"^")
.I SRNON S SRSS="2;;"_$P(^ECC(723,SRSS,0),"^")
.S SRENC=$O(^SCE("AVSIT",SRVSIT,0))
.I 'SRENC D S SRCNT(0)=SRCNT(0)+1 Q
..I '$D(^TMP("SRSP",$J,SRSS,0)) S ^TMP("SRSP",$J,SRSS,0)="0^0^0^0"
..S ^TMP("SRSP",$J,SRSS,SRTN)="",$P(^TMP("SRSP",$J,SRSS,0),"^")=$P(^TMP("SRSP",$J,SRSS,0),"^")+1,^TMP("SR69",$J,SRTN)=""
.K SRX S DA=SRENC,DIC=409.68,DR=".12",DIQ="SRX",DIQ(0)="IE" D EN^DIQ1 K DA,DIC,DIQ,DR
.S SRZ=SRX(409.68,SRENC,.12,"I") I SRZ'=12&(SRZ'=14) Q
.S SRCNT(SRZ)=SRCNT(SRZ)+1,^TMP("SR69",$J,SRTN)=SRX(409.68,SRENC,.12,"E")
.I '$D(^TMP("SRSP",$J,SRSS,0)) S ^TMP("SRSP",$J,SRSS,0)="0^0^0^0"
.S ^TMP("SRSP",$J,SRSS,SRTN)=SRX(409.68,SRENC,.12,"E"),$P(^TMP("SRSP",$J,SRSS,0),"^",$S(SRZ=12:2,1:3))=$P(^TMP("SRSP",$J,SRSS,0),"^",$S(SRZ=12:2,1:3))+1
F I=0,12,14 S SRCNT=SRCNT+SRCNT(I)
S ^TMP("SRSP",$J,0)=SRCNT(0)_"^"_SRCNT(12)_"^"_SRCNT(14)_"^"_SRCNT
S SRSS=0 F S SRSS=$O(^TMP("SRSP",$J,SRSS)) Q:SRSS="" D
.S X=0 F I=1:1:3 S X=X+$P(^TMP("SRSP",$J,SRSS,0),"^",I)
.S $P(^TMP("SRSP",$J,SRSS,0),"^",4)=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPCEU 6500 printed Dec 13, 2024@02:44:56 Page 2
SROPCEU ;BIR/ADM-List/Refile Not Transmitted Outpatient Encounters ; [ 09/22/98 11:41 AM ]
+1 ;;3.0; Surgery ;**69,77,50**;24 Jun 93
+2 SET (SRFLG,SRSORT,SRSOUT)=0
SET SRSPEC=""
+3 WRITE @IOF,!,?13,"Outpatient Surgery Encounters Not Transmitted to NPCD",!!!,"Surgical cases filed with PCE that have no Scheduling appointment status",!,"or that have an appointment status of ACTION REQUIRED or NON-COUNT indicate"
+4 WRITE !,"surgical encounters that have not transmitted to the National Patient",!,"Care Database. This option is intended as a tool to identify these",!,"encounters and, after taking appropriate corrective measures, to"
+5 WRITE !,"reinitiate the encounter transmission process.",!!
ASK KILL DIR
SET DIR("A",1)=" 1. Print list of cases."
SET DIR("A",2)=" 2. Print total number of cases only."
SET DIR("A",3)=" 3. Re-file cases in PCE."
SET DIR("A",4)=""
SET DIR("A")="Select Number: "
SET DIR("B")=1
+1 SET DIR("?",1)="Enter 1 to print a list of surgical cases and/or non-OR procedures that are"
SET DIR("?",2)="filed in PCE, but have no Scheduling appointment status or have an"
+2 SET DIR("?",3)="an appointment status of ACTION REQUIRED or NON-COUNT."
SET DIR("?",4)=""
SET DIR("?",5)="Enter 2 to print the total number of cases only with no list."
+3 SET DIR("?",6)=""
SET DIR("?",7)="Enter 3 to re-file in PCE surgical cases and/or non-OR procedures that are"
+4 SET DIR("?",8)="already filed, but have no Scheduling appointment status or have an"
SET DIR("?")="appointment status of ACTION REQUIRED or NON-COUNT."
+5 SET DIR(0)="NA^1:3:0"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
DO END
QUIT
+6 SET SRSEL=Y
WRITE !!
+7 SET DIR("A",1)=$SELECT(SRSEL=1:"Print the list for",SRSEL=2:"Print totals for",1:"Re-file")_" the following."
SET DIR("A",2)=""
SET DIR("A",3)=" 1. O.R. Surgical Procedures"
SET DIR("A",4)=" 2. Non-O.R. Procedures"
+8 SET DIR("A",5)=" 3. Both O.R. Surgical Procedures and Non-O.R. Procedures (All Specialties)"
SET DIR("A",6)=""
SET DIR("A")="Select Number (1, 2 or 3): "
SET DIR("B")="1"
+9 SET DIR(0)="NA^1:3:0"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
DO END
QUIT
+10 SET SRFLG=Y
IF SRFLG=1
DO SPEC
IF SRSOUT
DO END
QUIT
+11 IF SRFLG=2
DO MSP
IF SRSOUT
DO END
QUIT
+12 IF SRFLG=3
DO ALL
IF SRSOUT
DO END
QUIT
DATE DO DATE^SROUTL(.SDATE,.EDATE,.SRSOUT)
if SRSOUT
GOTO END
+1 IF SRSEL'=3
WRITE !
KILL %ZIS,IOP,IO("Q"),POP
Begin DoDot:1
+2 SET %ZIS("A")="Print report on which printer ? "
SET %ZIS="Q"
DO ^%ZIS
IF POP
SET SRSOUT=1
+3 IF $DATA(IO("Q"))
KILL IO("Q")
DO ZT
DO ^%ZTLOAD
SET SRSOUT=1
End DoDot:1
IF SRSOUT
DO END
QUIT
+4 IF SRSEL=3
DO ZT
SET ZTIO=""
DO ^%ZTLOAD
if $GET(ZTSK)
WRITE !," (Task #"_ZTSK_")"
DO END
QUIT
EN DO TMP
IF SRSEL'=3
DO ^SROPCEU0
+1 IF SRSEL=3
DO REFILE^SROPCEU0
END if $EXTRACT(IOST)="P"
WRITE @IOF
KILL ^TMP("SR69",$JOB),^TMP("SRSP",$JOB)
IF $DATA(ZTQUEUED)
if $GET(ZTSTOP)
QUIT
SET ZTREQ="@"
QUIT
+1 IF 'SRSOUT
IF $EXTRACT(IOST)'="P"
WRITE !!,"Press RETURN to continue "
READ X:DTIME
+2 DO ^%ZISC
KILL SR12,SRDIV,SRDX,SRENC,SRFCPT,SRFICD,SRFRTO,SRINOUT,SRPARAM,SRPODX,SRQCPT,SRQICD,SRRPT,SRSEL,SRSORT,SRSPS,SRSR,SRTN,SRUCPT,SRUICD
DO ^SRSKILL
WRITE @IOF
+3 QUIT
ZT SET ZTDESC=$SELECT(SRSEL=2:"Re-file",1:"Report of")_" Untransmitted Surgery Oupatient Encounters"
+1 SET (ZTSAVE("EDATE"),ZTSAVE("SDATE"),ZTSAVE("SRSITE*"),ZTSAVE("SRSPEC*"),ZTSAVE("SRFLG"),ZTSAVE("SRSEL"),ZTSAVE("SRSORT"))=""
+2 SET ZTRTN="EN^SROPCEU"
+3 QUIT
SPEC WRITE !
SET DIR("?",1)="Enter YES if you would like "_$SELECT(SRSEL=3:"re-filing",1:"the report printed")_" for all Surgical Specialties"
SET DIR("?")="or enter NO to select a specific specialty."
+1 SET DIR("A")="Do you want "_$SELECT(SRSEL=3:"re-filing",1:"the report")_" for all Surgical Specialties ? "
SET DIR("B")="YES"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+2 IF Y
DO ALL
QUIT
+3 IF 'Y
WRITE !
KILL DIC
SET DIC=137.45
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Surgical Specialty: "
SET DIC("S")="I '$P(^(0),""^"",3)"
DO ^DIC
KILL DIC
if Y<0
SET SRSOUT=1
if Y<0
QUIT
SET SRSPEC=+Y
SET SRSPECN=$PIECE(Y(0),"^")
+4 QUIT
ALL if SRSEL=3
QUIT
WRITE !
IF SRSEL=1
Begin DoDot:1
+1 SET DIR("?",1)="Enter YES if you would like the report to be sorted by specialty. Enter NO"
SET DIR("?")="if you would like all specialties combined and sorted by case number."
SET DIR("A")="Do you want the report sorted by Specialty ? "
End DoDot:1
+2 IF SRSEL=2
Begin DoDot:1
+3 SET DIR("?",1)="Enter YES if you would like the report to give totals for each specialty."
SET DIR("?")="Enter NO if you would like totals for all specialties combined."
SET DIR("A")="Do you want totals separated by Specialty ? "
End DoDot:1
+4 SET DIR("B")="YES"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+5 IF Y
SET SRSORT=1
+6 QUIT
MSP WRITE !
SET DIR("?",1)="Enter YES if you would like "_$SELECT(SRSEL=3:"re-filing",1:"the report printed")_" for all Medical Specialties"
SET DIR("?")="or enter NO to select a specific specialty."
+1 SET DIR("A")="Do you want "_$SELECT(SRSEL=3:"re-filing",1:"the report")_" for all Medical Specialties ? "
SET DIR("B")="YES"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
QUIT
+2 IF Y
DO ALL
QUIT
+3 IF 'Y
WRITE !
KILL DIC
SET DIC=723
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Medical Specialty: "
DO ^DIC
KILL DIC
if Y<0
SET SRSOUT=1
if Y<0
QUIT
SET SRSPEC=+Y
SET SRSPECN=$PIECE(Y(0),"^")
+4 QUIT
TMP ; identify cases with not transmitted encounters
+1 NEW SRVSIT
SET SRSDT=SDATE-.0001
SET SRSEDT=EDATE+.9999
KILL ^TMP("SR69",$JOB),^TMP("SRSP",$JOB)
if SRSORT
SET ^TMP("SRSP",$JOB,0)="0^0^0^0"
SET SRCNT=0
FOR I=0,12,14
SET SRCNT(I)=0
+2 FOR
SET SRSDT=$ORDER(^SRF("AC",SRSDT))
if 'SRSDT!(SRSDT>SRSEDT)
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SRSDT,SRTN))
if 'SRTN
QUIT
IF $DATA(^SRF(SRTN,0))
IF $$DIV^SROUTL0(SRTN)
Begin DoDot:1
+3 SET SR=^SRF(SRTN,0)
SET SR12=$PIECE(SR,"^",12)
SET SRVSIT=$PIECE(SR,"^",15)
if 'SRVSIT!(SR12'="O")
QUIT
+4 SET SRNON=0
IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"
SET SRNON=1
+5 IF SRFLG=1
IF SRNON
QUIT
+6 IF SRFLG=2
IF 'SRNON
QUIT
+7 SET SRSS=$SELECT('SRNON:$PIECE(SR,"^",4),1:$PIECE(^SRF(SRTN,"NON"),"^",8))
IF SRSPEC
IF SRSPEC'=SRSS
QUIT
+8 IF 'SRNON
SET SRSS="1;;"_$PIECE(^SRO(137.45,SRSS,0),"^")
+9 IF SRNON
SET SRSS="2;;"_$PIECE(^ECC(723,SRSS,0),"^")
+10 SET SRENC=$ORDER(^SCE("AVSIT",SRVSIT,0))
+11 IF 'SRENC
Begin DoDot:2
+12 IF '$DATA(^TMP("SRSP",$JOB,SRSS,0))
SET ^TMP("SRSP",$JOB,SRSS,0)="0^0^0^0"
+13 SET ^TMP("SRSP",$JOB,SRSS,SRTN)=""
SET $PIECE(^TMP("SRSP",$JOB,SRSS,0),"^")=$PIECE(^TMP("SRSP",$JOB,SRSS,0),"^")+1
SET ^TMP("SR69",$JOB,SRTN)=""
End DoDot:2
SET SRCNT(0)=SRCNT(0)+1
QUIT
+14 KILL SRX
SET DA=SRENC
SET DIC=409.68
SET DR=".12"
SET DIQ="SRX"
SET DIQ(0)="IE"
DO EN^DIQ1
KILL DA,DIC,DIQ,DR
+15 SET SRZ=SRX(409.68,SRENC,.12,"I")
IF SRZ'=12&(SRZ'=14)
QUIT
+16 SET SRCNT(SRZ)=SRCNT(SRZ)+1
SET ^TMP("SR69",$JOB,SRTN)=SRX(409.68,SRENC,.12,"E")
+17 IF '$DATA(^TMP("SRSP",$JOB,SRSS,0))
SET ^TMP("SRSP",$JOB,SRSS,0)="0^0^0^0"
+18 SET ^TMP("SRSP",$JOB,SRSS,SRTN)=SRX(409.68,SRENC,.12,"E")
SET $PIECE(^TMP("SRSP",$JOB,SRSS,0),"^",$SELECT(SRZ=12:2,1:3))=$PIECE(^TMP("SRSP",$JOB,SRSS,0),"^",$SELECT(SRZ=12:2,1:3))+1
End DoDot:1
+19 FOR I=0,12,14
SET SRCNT=SRCNT+SRCNT(I)
+20 SET ^TMP("SRSP",$JOB,0)=SRCNT(0)_"^"_SRCNT(12)_"^"_SRCNT(14)_"^"_SRCNT
+21 SET SRSS=0
FOR
SET SRSS=$ORDER(^TMP("SRSP",$JOB,SRSS))
if SRSS=""
QUIT
Begin DoDot:1
+22 SET X=0
FOR I=1:1:3
SET X=X+$PIECE(^TMP("SRSP",$JOB,SRSS,0),"^",I)
+23 SET $PIECE(^TMP("SRSP",$JOB,SRSS,0),"^",4)=X
End DoDot:1
+24 QUIT
