source: FOIAVistA/trunk/r/SURGERY-SR/SROPCE0.m@ 1470

Last change on this file since 1470 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.9 KB
Line 
1SROPCE0 ;BIR/ADM - PCE FILING STATUS REPORT ;03/17/05
2 ;;3.0; Surgery ;**58,62,69,77,50,119,142**;24 Jun 93
3 W @IOF,!,?26,"Report of PCE Filing Status",!!,"This report displays the filing status of completed cases performed during the",!,"selected date range.",!
4 S (SRFLG,SRSOUT)=0,SRSPEC=""
5ASK 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"
6 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"
7 S DIR(0)="NA^1:3:0" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 G END
8 S SRFLG=Y I SRFLG=1 D SPEC G:SRSOUT END
9 I SRFLG=2 D MSP G:SRSOUT END
10DATE D DATE^SROUTL(.SDATE,.EDATE,.SRSOUT) G:SRSOUT END
11FORM 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
12 S SRFORM=Y I Y="L" W !!,"This report is designed to use a 132 column format."
13 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
14 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
15EN 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
16 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
17 S SRINST=SRSITE("SITE") D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") S SRPRINT="Report Printed: "_Y
18 I SRFORM="L" D ^SROPCE0A G END
19 D ^SROPCE0B
20END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
21 I 'SRSOUT,$E(IOST)'="P" W !!,"Press RETURN to continue " R X:DTIME
22 D ^%ZISC K SRDIV,SRDX,SRFCPT,SRFICD,SRFRTO,SRINOUT,SRPARAM,SRPODX,SRQCPT,SRQICD,SRRPT,SRSCHED,SRSPS,SRSR,SRTN,SRUCPT,SRUICD D ^SRSKILL W @IOF
23 Q
24SPEC 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."
25 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
26 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),"^")
27 Q
28MSP 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."
29 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
30 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),"^")
31 Q
32CHK ; set up array of fields missing data
33 K SRX,DA,DIC,DIQ,DR,SRY S DIC="^SRF(",DA=SRTN,DIQ="SRY",DIQ(0)="I" D D EN^DIQ1
34 .I SRNON S DR="119;121;122;123;"_$S(SRSR'=0:"124;",1:"")_"125;"
35 .I 'SRNON S DR=".04;.14;"_$S(SRSR'=0:".164;",1:"")_".205;.232;"
36 .I $P(^SRO(133,SRSITE,0),"^",16) S DR=DR_".0155;"
37 .I SRSTATUS=5 S DR=DR_".011;"
38 D CLINIC
39 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)
40 I '$P($G(^SRO(136,SRTN,0)),"^",2) S SRX(.02)="PRINCIPAL PROCEDURE CODE"
41 I '$P($G(^SRO(136,SRTN,0)),"^",3) S SRX(.03)="PRIN POSTOP DIAGNOSIS CODE"
42OTH S SROTH=0,SROTH=$O(^SRO(136,SRTN,2,SROTH)) I SROTH="" S SRX(99998)="PRIN PROCEDURE CODE MISSING ASSOCIATED DIAGNOSIS CODE"
43 S SROTH=0 F S SROTH=$O(^SRO(136,SRTN,3,SROTH)) Q:'SROTH D
44 .I '$D(^SRO(136,SRTN,3,SROTH,2)) S SRX(99999)="OTHER PROCEDURE CPT MISSING ASSOCIATED DIAGNOSIS ICD CODE" Q
45 .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
46 Q
47CLINIC N SRCLINIC S SRCLINIC=$P(^SRF(SRTN,0),"^",21) D
48 .I SRNON S:SRCLINIC="" SRCLINIC=$P(^SRF(SRTN,"NON"),"^",2) Q
49 .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),"^")
50 I SRCLINIC,'$$CLINIC^SROUTL(SRCLINIC,SRTN) S SRCLINIC=""
51 S SRY(130,SRTN,.021,"I")=SRCLINIC
52 Q
53TR S SRP=SRZ,SRP=$TR(SRP,"1234567890.","ABCDEFGHIJP")
54 Q
55PJAA ;;.011^IN/OUT-PATIENT STATUS
56PJAEE ;;.0155^CLASSIFICATION INFORMATION
57PJBA ;;.021^ASSOCIATED CLINIC
58PJD ;;.04^SURGERY SPECIALTY
59PAFD ;;.164^ATTEND SURG
60PBJE ;;.205^TIME PAT IN OR
61PBCB ;;.232^TIME PAT OUT OR
62AAI ;;119^NON-OR LOCATION
63ABA ;;121^TIME PROCEDURE BEGAN
64ABB ;;122^TIME PROCEDURE ENDED
65ABC ;;123^PROVIDER
66ABD ;;124^ATTEND PROVIDER
67ABE ;;125^MEDICAL SPECIALTY
Note: See TracBrowser for help on using the repository browser.