SROPCE0 ;BIR/ADM - PCE FILING STATUS REPORT ;03/17/05
;;3.0;Surgery;**58,62,69,77,50,119,142,182**;24 Jun 93;Build 49
W @IOF,!,?26,"Report of PCE Filing Status",!!,"This report displays the filing status of completed cases performed during the",!,"selected date range.",!
S (SRFLG,SRSOUT)=0,SRSPEC=""
ASK W ! K DIR S DIR("A",1)="Print PCE filing status of completed cases for",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 G END
S SRFLG=Y I SRFLG=1 D SPEC G:SRSOUT END
I SRFLG=2 D MSP G:SRSOUT END
DATE D DATE^SROUTL(.SDATE,.EDATE,.SRSOUT) G:SRSOUT END
FORM W ! K DIR S DIR("A")="Print the long form or the short form ? ",DIR("B")="SHORT",DIR(0)="SAM^L:LONG;S:SHORT" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END
S SRFORM=Y I Y="L" W !!,"This report is designed to use a 132 column format."
W ! K %ZIS,IOP,IO("Q"),POP S %ZIS("A")="Print the PCE Filing Status Report to which Printer ? ",%ZIS="Q" D ^%ZIS I POP S SRSOUT=1 G END
I $D(IO("Q")) K IO("Q") S ZTDESC="PCE FILING STATUS REPORT",(ZTSAVE("EDATE"),ZTSAVE("SRFORM"),ZTSAVE("SDATE"),ZTSAVE("SRSITE*"),ZTSAVE("SRSPEC*"),ZTSAVE("SRFLG"))="",ZTRTN="EN^SROPCE0" D ^%ZTLOAD S SRSOUT=1 G END
EN U IO S SRSOUT=0,(SRHDR,SRPAGE)=1,SRSDT=SDATE-.0001,SRSEDT=EDATE+.9999,Y=SDATE X ^DD("DD") S STARTDT=Y,Y=EDATE X ^DD("DD") S ENDATE=Y F I=1:1:6 S CNT(I)=0
S SRRPT="PCE FILING STATUS REPORT",SRTITLE="For Completed "_$S(SRFLG=1:"O.R. Surgical Procedures",SRFLG=2:"Non-O.R. Procedures",1:"O.R. Surgical and Non-O.R. Procedures"),SRFRTO="From: "_STARTDT_" To: "_ENDATE
S SRINST=SRSITE("SITE") D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") S SRPRINT="Report Printed: "_Y
I SRFORM="L" D ^SROPCE0A G END
D ^SROPCE0B
END W:$E(IOST)="P" @IOF 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 SRDIV,SRDX,SRFCPT,SRFICD,SRFRTO,SRINOUT,SRPARAM,SRPODX,SRQCPT,SRQICD,SRRPT,SRSCHED,SRSPS,SRSR,SRTN,SRUCPT,SRUICD D ^SRSKILL W @IOF
Q
SPEC W @IOF,! S DIR("?",1)="Enter YES if you would like the report printed for all Surgical Specialties",DIR("?")="or enter NO to select a specific specialty."
S DIR("A")="Do you want 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 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
MSP W @IOF,! S DIR("?",1)="Enter YES if you would like the report printed for all Medical Specialties",DIR("?")="or enter NO to select a specific specialty."
S DIR("A")="Do you want 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 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
CHK ; set up array of fields missing data
K SRX,DA,DIC,DIQ,DR,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="I" D D EN^DIQ1
.I SRNON S DR="119;121;122;123;"_$S(SRSR'=0:"124;",1:"")_"125;"
.I 'SRNON S DR=".04;.14;"_$S(SRSR'=0:".164;",1:"")_".205;.232;"
.I $P(^SRO(133,SRSITE,0),"^",16) S DR=DR_".0155;"
.I SRSTATUS=5 S DR=DR_".011;"
D CLINIC
S SRZ=0 F S SRZ=$O(SRY(130,SRTN,SRZ)) Q:'SRZ I SRY(130,SRTN,SRZ,"I")="" D TR S X=$T(@SRP),SRFLD=$P(X,";;",2),SRX(SRZ)=$P(SRFLD,"^",2)
I '$P($G(^SRO(136,SRTN,0)),"^",2) S SRX(.02)="PRINCIPAL PROCEDURE CODE"
I '$P($G(^SRO(136,SRTN,0)),"^",3) S SRX(.03)="PRIN POSTOP DIAGNOSIS CODE"
OTH S SROTH=0,SROTH=$O(^SRO(136,SRTN,2,SROTH)) I SROTH="" S SRX(99998)="PRIN PROCEDURE CODE MISSING ASSOCIATED DIAGNOSIS CODE"
S SROTH=0 F S SROTH=$O(^SRO(136,SRTN,3,SROTH)) Q:'SROTH D
.I '$D(^SRO(136,SRTN,3,SROTH,2)) S SRX(99999)="OTHER PROCEDURE CPT MISSING ASSOCIATED DIAGNOSIS ICD CODE" Q
.S SRZ=0 S SRZ=$O(^SRO(136,SRTN,3,SROTH,2,SRZ)) I 'SRZ S SRX(99999)="OTHER PROCEDURE CPT MISSING ASSOCIATED DIAGNOSIS ICD CODE" Q
Q
CLINIC N SRCLINIC S SRCLINIC=$P(^SRF(SRTN,0),"^",21) D
.I SRNON S:SRCLINIC="" SRCLINIC=$P(^SRF(SRTN,"NON"),"^",2) Q
.S:SRCLINIC="" SRCLINIC=$P(^SRO(137.45,$P(^SRF(SRTN,0),"^",4),0),"^",5) I SRCLINIC="",$P(^SRF(SRTN,0),"^",2) S SRCLINIC=$P(^SRS($P(^SRF(SRTN,0),"^",2),0),"^")
I SRCLINIC,'$$CLINIC^SROUTL(SRCLINIC,SRTN) S SRCLINIC=""
S SRY(130,SRTN,.021,"I")=SRCLINIC
Q
TR S SRP=SRZ,SRP=$TR(SRP,"1234567890.","ABCDEFGHIJP")
Q
PJAA ;;.011^HOSPITAL ADMISSION STATUS
PJAEE ;;.0155^CLASSIFICATION INFORMATION
PJBA ;;.021^ASSOCIATED CLINIC
PJD ;;.04^SURGERY SPECIALTY
PAFD ;;.164^ATTENDING SURGEON
PBJE ;;.205^TIME PAT IN OR
PBCB ;;.232^TIME PAT OUT OR
AAI ;;119^NON-OR LOCATION
ABA ;;121^TIME PROCEDURE BEGAN
ABB ;;122^TIME PROCEDURE ENDED
ABC ;;123^PROVIDER
ABD ;;124^ATTEND PROVIDER
ABE ;;125^MEDICAL SPECIALTY
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROPCE0 5094 printed Nov 22, 2024@17:54:50 Page 2
SROPCE0 ;BIR/ADM - PCE FILING STATUS REPORT ;03/17/05
+1 ;;3.0;Surgery;**58,62,69,77,50,119,142,182**;24 Jun 93;Build 49
+2 WRITE @IOF,!,?26,"Report of PCE Filing Status",!!,"This report displays the filing status of completed cases performed during the",!,"selected date range.",!
+3 SET (SRFLG,SRSOUT)=0
SET SRSPEC=""
ASK WRITE !
KILL DIR
SET DIR("A",1)="Print PCE filing status of completed cases for"
SET DIR("A",2)=""
SET DIR("A",3)="1. O.R. Surgical Procedures"
SET DIR("A",4)="2. Non-O.R. Procedures"
+1 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"
+2 SET DIR(0)="NA^1:3:0"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
GOTO END
+3 SET SRFLG=Y
IF SRFLG=1
DO SPEC
if SRSOUT
GOTO END
+4 IF SRFLG=2
DO MSP
if SRSOUT
GOTO END
DATE DO DATE^SROUTL(.SDATE,.EDATE,.SRSOUT)
if SRSOUT
GOTO END
FORM WRITE !
KILL DIR
SET DIR("A")="Print the long form or the short form ? "
SET DIR("B")="SHORT"
SET DIR(0)="SAM^L:LONG;S:SHORT"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SRSOUT=1
GOTO END
+1 SET SRFORM=Y
IF Y="L"
WRITE !!,"This report is designed to use a 132 column format."
+2 WRITE !
KILL %ZIS,IOP,IO("Q"),POP
SET %ZIS("A")="Print the PCE Filing Status Report to which Printer ? "
SET %ZIS="Q"
DO ^%ZIS
IF POP
SET SRSOUT=1
GOTO END
+3 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTDESC="PCE FILING STATUS REPORT"
SET (ZTSAVE("EDATE"),ZTSAVE("SRFORM"),ZTSAVE("SDATE"),ZTSAVE("SRSITE*"),ZTSAVE("SRSPEC*"),ZTSAVE("SRFLG"))=""
SET ZTRTN="EN^SROPCE0"
DO ^%ZTLOAD
SET SRSOUT=1
GOTO END
EN USE IO
SET SRSOUT=0
SET (SRHDR,SRPAGE)=1
SET SRSDT=SDATE-.0001
SET SRSEDT=EDATE+.9999
SET Y=SDATE
XECUTE ^DD("DD")
SET STARTDT=Y
SET Y=EDATE
XECUTE ^DD("DD")
SET ENDATE=Y
FOR I=1:1:6
SET CNT(I)=0
+1 SET SRRPT="PCE FILING STATUS REPORT"
SET SRTITLE="For Completed "_$SELECT(SRFLG=1:"O.R. Surgical Procedures",SRFLG=2:"Non-O.R. Procedures",1:"O.R. Surgical and Non-O.R. Procedures")
SET SRFRTO="From: "_STARTDT_" To: "_ENDATE
+2 SET SRINST=SRSITE("SITE")
DO NOW^%DTC
SET Y=$EXTRACT(%,1,12)
XECUTE ^DD("DD")
SET SRPRINT="Report Printed: "_Y
+3 IF SRFORM="L"
DO ^SROPCE0A
GOTO END
+4 DO ^SROPCE0B
END if $EXTRACT(IOST)="P"
WRITE @IOF
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 SRDIV,SRDX,SRFCPT,SRFICD,SRFRTO,SRINOUT,SRPARAM,SRPODX,SRQCPT,SRQICD,SRRPT,SRSCHED,SRSPS,SRSR,SRTN,SRUCPT,SRUICD
DO ^SRSKILL
WRITE @IOF
+3 QUIT
SPEC WRITE @IOF,!
SET DIR("?",1)="Enter YES if you would like the report printed for all Surgical Specialties"
SET DIR("?")="or enter NO to select a specific specialty."
+1 SET DIR("A")="Do you want 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
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),"^")
+3 QUIT
MSP WRITE @IOF,!
SET DIR("?",1)="Enter YES if you would like the report printed for all Medical Specialties"
SET DIR("?")="or enter NO to select a specific specialty."
+1 SET DIR("A")="Do you want 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
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),"^")
+3 QUIT
CHK ; set up array of fields missing data
+1 KILL SRX,DA,DIC,DIQ,DR,SRY
SET DIC="^SRF("
SET DA=SRTN
SET DIQ="SRY"
SET DIQ(0)="I"
Begin DoDot:1
+2 IF SRNON
SET DR="119;121;122;123;"_$SELECT(SRSR'=0:"124;",1:"")_"125;"
+3 IF 'SRNON
SET DR=".04;.14;"_$SELECT(SRSR'=0:".164;",1:"")_".205;.232;"
+4 IF $PIECE(^SRO(133,SRSITE,0),"^",16)
SET DR=DR_".0155;"
+5 IF SRSTATUS=5
SET DR=DR_".011;"
End DoDot:1
DO EN^DIQ1
+6 DO CLINIC
+7 SET SRZ=0
FOR
SET SRZ=$ORDER(SRY(130,SRTN,SRZ))
if 'SRZ
QUIT
IF SRY(130,SRTN,SRZ,"I")=""
DO TR
SET X=$TEXT(@SRP)
SET SRFLD=$PIECE(X,";;",2)
SET SRX(SRZ)=$PIECE(SRFLD,"^",2)
+8 IF '$PIECE($GET(^SRO(136,SRTN,0)),"^",2)
SET SRX(.02)="PRINCIPAL PROCEDURE CODE"
+9 IF '$PIECE($GET(^SRO(136,SRTN,0)),"^",3)
SET SRX(.03)="PRIN POSTOP DIAGNOSIS CODE"
OTH SET SROTH=0
SET SROTH=$ORDER(^SRO(136,SRTN,2,SROTH))
IF SROTH=""
SET SRX(99998)="PRIN PROCEDURE CODE MISSING ASSOCIATED DIAGNOSIS CODE"
+1 SET SROTH=0
FOR
SET SROTH=$ORDER(^SRO(136,SRTN,3,SROTH))
if 'SROTH
QUIT
Begin DoDot:1
+2 IF '$DATA(^SRO(136,SRTN,3,SROTH,2))
SET SRX(99999)="OTHER PROCEDURE CPT MISSING ASSOCIATED DIAGNOSIS ICD CODE"
QUIT
+3 SET SRZ=0
SET SRZ=$ORDER(^SRO(136,SRTN,3,SROTH,2,SRZ))
IF 'SRZ
SET SRX(99999)="OTHER PROCEDURE CPT MISSING ASSOCIATED DIAGNOSIS ICD CODE"
QUIT
End DoDot:1
+4 QUIT
CLINIC NEW SRCLINIC
SET SRCLINIC=$PIECE(^SRF(SRTN,0),"^",21)
Begin DoDot:1
+1 IF SRNON
if SRCLINIC=""
SET SRCLINIC=$PIECE(^SRF(SRTN,"NON"),"^",2)
QUIT
+2 if SRCLINIC=""
SET SRCLINIC=$PIECE(^SRO(137.45,$PIECE(^SRF(SRTN,0),"^",4),0),"^",5)
IF SRCLINIC=""
IF $PIECE(^SRF(SRTN,0),"^",2)
SET SRCLINIC=$PIECE(^SRS($PIECE(^SRF(SRTN,0),"^",2),0),"^")
End DoDot:1
+3 IF SRCLINIC
IF '$$CLINIC^SROUTL(SRCLINIC,SRTN)
SET SRCLINIC=""
+4 SET SRY(130,SRTN,.021,"I")=SRCLINIC
+5 QUIT
TR SET SRP=SRZ
SET SRP=$TRANSLATE(SRP,"1234567890.","ABCDEFGHIJP")
+1 QUIT
PJAA ;;.011^HOSPITAL ADMISSION STATUS
PJAEE ;;.0155^CLASSIFICATION INFORMATION
PJBA ;;.021^ASSOCIATED CLINIC
PJD ;;.04^SURGERY SPECIALTY
PAFD ;;.164^ATTENDING SURGEON
PBJE ;;.205^TIME PAT IN OR
PBCB ;;.232^TIME PAT OUT OR
AAI ;;119^NON-OR LOCATION
ABA ;;121^TIME PROCEDURE BEGAN
ABB ;;122^TIME PROCEDURE ENDED
ABC ;;123^PROVIDER
ABD ;;124^ATTEND PROVIDER
ABE ;;125^MEDICAL SPECIALTY
