SROPCE0A ;BIR/ADM - PCE FILING STATUS REPORT, LONG FORM ;03/17/05
 ;;3.0; Surgery ;**58,62,69,77,50,86,88,127,142**;24 Jun 93
 ;
 ; Reference to ^ECC(723 supported by DBIA #205
 ;
 S (SRFCPT,SRQCPT,SRFICD,SRQICD,SRUCPT,SRUICD)=0
 D HDR F  S SRSDT=$O(^SRF("AC",SRSDT)) Q:'SRSDT!(SRSDT>SRSEDT)!SRSOUT  S SRTN=0 F  S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN  I $D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN),$P($G(^SRF(SRTN,30)),"^")="" D UTIL Q:SRSOUT
 D:'SRSOUT TOTAL
 Q
TOTAL D:$Y+10>IOSL PAGE Q:SRSOUT  W !,?28,"CPT",?36,"ICD",!,?20,"CASES",?27,"CODES",?35,"CODES",!,?13,"FILED: ",$J(CNT(1),5),?27,$J(SRFCPT,5),?35,$J(SRFICD,5)
 W !,?9,"NOT FILED: "_$J(CNT(4),5) F I=1:1:5 S CNT(6)=CNT(6)+CNT(I)
 W:CNT(5) !,?9,"UNCERTAIN: "_$J(CNT(5),5) W !,?20,"-----",?27,"-----",?35,"-----",!,?13,"TOTAL: ",$J(CNT(6),5),?27,$J(SRFCPT+SRQCPT+SRUCPT,5),?35,$J(SRFICD+SRQICD+SRUICD,5)
 Q
UTIL ; process case
 S SRDIV=$P($G(^SRF(SRTN,8)),"^") I SRDIV S SRSPS=$O(^SRO(133,"B",SRDIV,0))
 I 'SRDIV S SRSPS=SRSITE
 S X=^SRO(133,SRSPS,0),SRPARAM=$P(X,"^",15),SRSR=$P(X,"^",19) I SRPARAM=""!(SRPARAM="N") Q
 S SRINOUT=$P(^SRF(SRTN,0),"^",12) I SRPARAM="O",SRINOUT'="",SRINOUT'="O" Q
 S SRNON=0 I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SRNON=1
 I SRFLG=1!(SRFLG=3&('SRNON)) Q:'$P($G(^SRF(SRTN,.2)),"^",12)
 I SRFLG=2!(SRFLG=3&SRNON) Q:'$P($G(^SRF(SRTN,"NON")),"^",5)
 Q:SRFLG=2&('SRNON)  Q:SRFLG=1&(SRNON)
 S SRSS=$S('SRNON:$P(^SRF(SRTN,0),"^",4),1:$P(^SRF(SRTN,"NON"),"^",8)) I SRSPEC,SRSPEC'=SRSS Q
 S SRSSNM=$S('SRNON:$P(^SRO(137.45,SRSS,0),"^"),1:$P(^ECC(723,SRSS,0),"^"))
 I SRPARAM="O",SRINOUT="" S SRSTATUS=5,CNT(5)=CNT(5)+1 D CASE,CHK^SROPCE0,MISS Q
 I $P(^SRF(SRTN,0),"^",15) S SRSTATUS=1,CNT(1)=CNT(1)+1 D CASE,LINE Q
 S SRSTATUS=4,CNT(4)=CNT(4)+1 D CASE,CHK^SROPCE0,MISS
 Q
MISS ; list fields missing data
 Q:SRSOUT  S SRFLD="" S SRFLD=$O(SRX(SRFLD)) I SRFLD="" W !,?15,"No Missing Information" D LINE Q
 S SRCT=1,SRFLD="" W !,?15,"Missing Information:" F  S SRFLD=$O(SRX(SRFLD)) Q:SRFLD=""  D:$Y+5>IOSL PAGE Q:SRSOUT  W !,$J(SRCT_". ",20),SRX(SRFLD) S SRCT=SRCT+1
LINE I 'SRSOUT W ! F I=1:1:IOM W "-"
 Q
CASE ; print case info
 D:$Y+9>IOSL PAGE Q:SRSOUT  D DEM,SCHED^SROPCE0B
 W !,SRSDATE,?22,SRSNM,?49,SRPROV,?71,SRSSNM,?113,$S(SRSTATUS=1:"FILED",SRSTATUS=4:"NOT FILED",1:"UNCERTAIN")
 W !,SRTN,?22,SRSSN_"  ("_SRAGE_")",?49,SRATT,?71,SRDIAG(1),?113,$E(SRSCHED,1,17),!
 W:(SRFLG=3)&SRNON "NON-OR" W ?22,SRPROC(1) W:$D(SRDIAG(2)) ?71,SRDIAG(2) W:$D(SRPROC(2)) !,?22,SRPROC(2) W:$D(SRPROC(3)) !,?22,SRPROC(3) W !
 I "1,2,3"[SRSTATUS F SRI=1:1 Q:'$D(SRCPT(SRI))&'$D(SRDX(SRI))  D:$Y+4>IOSL PAGE Q:SRSOUT  W ! D  W:$D(SRDX(SRI)) ?71,"ICD Diagnosis Code: "_SRDX(SRI)
 .I $D(SRCPT(SRI)) S SRCPT(SRI)=$S($D(SRDX(SRI)):$E(SRCPT(SRI),1,68),1:SRCPT(SRI)) W ?1,SRCPT(SRI)
 Q
DEM ; get patient demographic information
 S SR(0)=^SRF(SRTN,0),DFN=$P(SR(0),"^") D DEM^VADPT S SRSNM=VADM(1),SRSSN=VA("PID"),Y=SRSDT X ^DD("DD") S SRSDATE=Y,X1=$E(SRSDT,1,7),X2=$P(VADM(3),"^"),SRAGE=$E(X1,1,3)-$E(X2,1,3)-($E(X1,4,7)<$E(X2,4,7))
 I $L(SRSNM)>25 S X=SRSNM,SRSNM=$P(X,",")_","_$E($P(X,",",2))_"."
PROC ; get principal procedure and other case information
 K SRPROC S X=$P(^SRF(SRTN,"OP"),"^") I $L(X)<60 S SRPROC(1)=X
 I $L(X)>59 S K=1 F  D  I $L(X)<60 S SRPROC(K)=X Q
 .F I=0:1:58 S J=59-I,Y=$E(X,J) I Y=" " S SRPROC(K)=$E(X,1,J-1),X=$E(X,J+1,$L(X)) S K=K+1 Q
 K SRDIAG S X=$S(SRNON:$P($G(^SRF(SRTN,33)),"^",2),1:$P($G(^SRF(SRTN,34)),"^")) I $L(X)<40 S SRDIAG(1)=X
 I $L(X)>39 S K=1 F  D  I $L(X)<40 S SRDIAG(K)=X Q
 .F I=0:1:38 S J=39-I,Y=$E(X,J) I Y=" " S SRDIAG(K)=$E(X,1,J-1),X=$E(X,J+1,$L(X)) S K=K+1 Q
 I SRDIAG(1)="" S SRDIAG(1)="NOT ENTERED"
 I SRNON S X=$G(^SRF(SRTN,"NON")) S SRPROV=$S($P(X,"^",6):$P(^VA(200,$P(X,"^",6),0),"^"),1:"NOT ENTERED"),SRATT=$S($P(X,"^",7):$P(^VA(200,$P(X,"^",7),0),"^"),1:"NOT ENTERED")
 I 'SRNON S X=$G(^SRF(SRTN,.1)) S SRPROV=$S($P(X,"^",4):$P(^VA(200,$P(X,"^",4),0),"^"),1:"NOT ENTERED"),SRATT=$S($P(X,"^",13):$P(^VA(200,$P(X,"^",13),0),"^"),1:"NOT ENTERED")
 I $L(SRPROV)>20 S X=SRPROV,SRPROV=$P(X,",")_","_$E($P(X,",",2))_"."
 I $L(SRATT)>20 S X=SRATT,SRATT=$P(X,",")_","_$E($P(X,",",2))_"."
 Q:"1,2,3"'[SRSTATUS
CPT ; get CPT codes
 N SRICPT K SRCPT S SRJ=1,X=$P($G(^SRO(136,SRTN,0)),"^",2) I X D
 .S SRICPT=$$CPT^ICPTCOD(X,$P($G(^SRF(SRTN,0)),"^",9)),SRCPT(1)="CPT Code: "_$P(SRICPT,"^",2)_"  "_$P(SRICPT,"^",3),SRJ=SRJ+1
 .S:SRSTATUS=1 SRFCPT=SRFCPT+1 S:SRSTATUS=2 SRQCPT=SRQCPT+1 S:SRSTATUS=3 SRUCPT=SRUCPT+1
 .I X,$O(^SRO(136,SRTN,1,0)) D
 ..N SRI,SRX,SRY,SRZ S SRX=" Modifiers: -"
 ..S SRI=0 F  S SRI=$O(^SRO(136,SRTN,1,SRI)) Q:'SRI  D
 ...S SRZ=$P(^SRO(136,SRTN,1,SRI,0),"^"),SRY=$$MOD^ICPTMOD(SRZ,"I",$P($G(^SRF(SRTN,0)),"^",9)),SRX=SRX_$P(SRY,"^",2)_" "_$P(SRY,"^",3)
 ...S SRCPT(SRJ)=SRX,SRJ=SRJ+1,SRX="            -"
 S SROP=0 F  S SROP=$O(^SRO(136,SRTN,3,SROP)) Q:'SROP  S X=$P($G(^SRO(136,SRTN,3,SROP,0)),"^") I X D
 .S SRICPT=$$CPT^ICPTCOD(X,$P($G(^SRF(SRTN,0)),"^",9)),SRCPT(SRJ)="CPT Code: "_$P(SRICPT,"^",2)_"  "_$P(SRICPT,"^",3),SRJ=SRJ+1
 .I $O(^SRO(136,SRTN,3,SROP,1,0)) D
 ..N SRI,SRX,SRY,SRZ S SRX=" Modifiers: -"
 ..S SRI=0 F  S SRI=$O(^SRO(136,SRTN,3,SROP,1,SRI)) Q:'SRI  D
 ...S SRZ=$P(^SRO(136,SRTN,3,SROP,1,SRI,0),"^"),SRY=$$MOD^ICPTMOD(SRZ,"I",$P($G(^SRF(SRTN,0)),"^",9)),SRX=SRX_$P(SRY,"^",2)_" "_$P(SRY,"^",3)
 ...S SRCPT(SRJ)=SRX,SRJ=SRJ+1,SRX="            -"
 .S:SRSTATUS=1 SRFCPT=SRFCPT+1 S:SRSTATUS=2 SRQCPT=SRQCPT+1 S:SRSTATUS=3 SRUCPT=SRUCPT+1
DX ; get diagnosis and ICD codes
 K SRDX S SRJ=1,X=$P($G(^SRO(136,SRTN,0)),"^",3) I X D
 .S SRDX(1)=$$ICDDX^ICDCODE(X,$P($G(^SRF(SRTN,0)),"^",9)),SRDX(1)=$P(SRDX(1),"^",2)_"  "_$P(SRDX(1),"^",4),SRJ=SRJ+1
 .S:SRSTATUS=1 SRFICD=SRFICD+1 S:SRSTATUS=2 SRQICD=SRQICD+1 S:SRSTATUS=3 SRUICD=SRUICD+1
 S SRPODX=0 F  S SRPODX=$O(^SRO(136,SRTN,4,SRPODX)) Q:'SRPODX  S X=$P(^SRO(136,SRTN,4,SRPODX,0),"^") I X D
 .S SRDX(SRJ)=$$ICDDX^ICDCODE(X,$P($G(^SRF(SRTN,0)),"^",9)),SRDX(SRJ)=$P(SRDX(SRJ),"^",2)_"  "_$P(SRDX(SRJ),"^",4),SRJ=SRJ+1
 .S:SRSTATUS=1 SRFICD=SRFICD+1 S:SRSTATUS=2 SRQICD=SRQICD+1 S:SRSTATUS=3 SRUICD=SRUICD+1
 Q
PAGE I $E(IOST)="P"!SRHDR G HDR
 W ! K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRSOUT=1 Q
HDR ; print heading
 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
 W:$Y @IOF W:$E(IOST)="P" !,?(IOM-$L(SRINST)\2),SRINST W !,?(IOM-$L(SRRPT)\2),SRRPT,?(IOM-10),$J("PAGE "_SRPAGE,9),!,?(IOM-$L(SRTITLE)\2),SRTITLE,!,?(IOM-$L(SRFRTO)\2),SRFRTO W:$E(IOST)="P" !,?(IOM-$L(SRPRINT)\2),SRPRINT
 W !!,"DATE OF "_$S(SRFLG=1:"OPERATION",SRFLG=2:"PROCEDURE",1:"OP/PROCEDURE"),?22,"PATIENT NAME",?49,$S(SRFLG=1:"SURGEON",SRFLG=2:"PROVIDER",1:"SURGEON/PROVIDER"),?71,"SPECIALTY",?113,"PCE FILING STATUS"
 W !,"CASE #",?22,"PATIENT ID  (AGE)",?49,"ATTENDING",?71,"PRINCIPAL "_$S(SRFLG=1:"POST-OP ",1:"")_"DIAGNOSIS",?113,"SCHED STATUS",!,?22,"PRINCIPAL PROCEDURE"
 S SRHDR=0,SRPAGE=SRPAGE+1 W ! F I=1:1:IOM W "="
 Q