SROPCE0.m

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 ---SROPCE0   5094     printed  Feb 19, 2025@00:11:21                                                                                                                                                                                                     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