SROACC0 ;BIR/MAM - CPT ACCURACY SORT BY SPECIALTY ;05/13/99 2:33 PM
;;3.0; Surgery ;**50,88,142**;24 Jun 93
DEV W !!,"This report is designed to use a 132 column format.",!!
K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Select Device: ",%ZIS="QM" D ^%ZIS I POP S SRSOUT=1 G END
I $D(IO("Q")) K IO("Q") S ZTRTN="EN^SROACC0",(ZTSAVE("SRSS"),ZTSAVE("SDATE*"),ZTSAVE("EDATE*"),ZTSAVE("SRCPT"),ZTSAVE("SRFLG"),ZTSAVE("SRSITE*"))="",ZTDESC="REPORT TO CHECK CPT CODING ACCURACY" D ^%ZTLOAD G END
EN ; entry when queued
K ^TMP("SR",$J) U IO S SRSOUT=0,SRPAGE=1,SRINST=SRSITE("SITE")
N SRFRTO S Y=SDATE X ^DD("DD") S SRFRTO="FROM: "_Y_" TO: " S Y=EDATE X ^DD("DD") S SRFRTO=SRFRTO_Y
I SRCPT="ALL",SRSS="ALL" D ^SROACC1 G END
I SRCPT="ALL",SRSS D ^SROACC2 G END
I SRCPT,SRSS="ALL" D ^SROACC3 G END
D ^SROACC4
END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP) S ZTREQ="@" Q
I 'SRSOUT,$E(IOST)'="P" W !!,"Press RETURN to continue " R X:DTIME
D ^%ZISC W @IOF K SRTN D ^SRSKILL
Q
HDR ; print heading
I SRHDR,$E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,?126,"PAGE",!,?58,"SURGICAL SERVICE",?126,$J(SRPAGE,4),!,?51,"REPORT OF CPT CODING ACCURACY",?100,"REVIEWED BY:"
W ! W:SRSS'="" ?(132-$L("FOR "_SRSS)\2),"FOR "_SRSS W ?100,"DATE REVIEWED:"
W !,?(132-$L(SRFRTO)\2),SRFRTO
W !,$S(SRFLG=1:"O.R. SURGICAL PROCEDURES",SRFLG=2:"NON-O.R. PROCEDURES",1:"O.R. SURGICAL PROCEDURES AND NON-O.R. PROCEDURES")
W !!,?1,"PROCEDURE DATE",?20,"PATIENT",?60,"PROCEDURES",?111,"SURGEON/PROVIDER",!,?3,"CASE #",?22,"ID#",?111,"ATTEND SURG/PROV"
S SRHDR=1,SRPAGE=SRPAGE+1 Q
SPEC W !!!,"Do you want to print the Report to Check Coding Accuracy for all",!,"Surgical Specialties ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
I "YyNn"'[SRYN W !!,"Enter RETURN if you want to print the report for all specialties, or 'NO'",!,"to select a specific Surgical Specialty.",!!,"Press RETURN to continue " R X:DTIME G SPEC
S SRSS="ALL" I "Nn"[SRYN W !! K DIC S DIC("S")="I '$P(^(0),""^"",3)",DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Print the Coding Accuracy Report for which Surgical Specialty ? " D ^DIC S:Y<0 SRSOUT=1 G:Y<0 END S SRSS=+Y
D DEV Q
MSP I SRFLG=3 S SRSS="ALL" G DEV
W !!!,"Do you want to print the Report to Check Coding Accuracy for all",!,"Medical Specialties ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
I "YyNn"'[SRYN W !!,"Enter RETURN if you want to print the report for all specialties, or 'NO'",!,"to select a specific Medical Specialty.",!!,"Press RETURN to continue " R X:DTIME G MSP
S SRSS="ALL" I "Nn"[SRYN W !! K DIC S DIC=723,DIC(0)="QEAMZ",DIC("A")="Print the Coding Accuracy Report for which Medical Specialty ? " D ^DIC S:Y<0 SRSOUT=1 G:Y<0 END S SRSS=+Y
D DEV
Q
OPER N CPT,SRCPT K SROPERS,SRCPTT S SRX=^SRF(SRTN,"OP"),SROPER=$P(SRX,"^")
I $O(^SRF(SRTN,13,0)) S SROPER=SROPER_", OTHER OPERATIONS: " S OTH=0 F S OTH=$O(^SRF(SRTN,13,OTH)) Q:'OTH D OTHER
OPERT ; patch SR*3*142 changes
S CPT=$P($G(^SRO(136,SRTN,0)),"^",2),SRCPT=$S(CPT:$P($$CPT^ICPTCOD(CPT),"^",2),1:"CPT NOT ENTERED") S SRCPTT="CPT Codes: "_SRCPT I CPT D PMOD
I $O(^SRO(136,SRTN,3,0)) S OTH=0 F S OTH=$O(^SRO(136,SRTN,3,OTH)) Q:'OTH D OTHERT
Q
OTHER ; other procedures
S SRLONG=1,SROPERS=$P(^SRF(SRTN,13,OTH,0),"^")
I $L(SROPER)+$L(SROPERS)>250 S SROPER=SROPER_" ...",OTH=999 Q
S SROPER=SROPER_$S(OTH=1:" ",1:", ")_SROPERS
Q
OTHERT ; other procedures - file #136
S SRLONG=1,CPT=$P($G(^SRO(136,SRTN,3,OTH,0)),"^"),SRCPT=$S(CPT:$P($$CPT^ICPTCOD(CPT),"^",2),1:"CPT NOT ENTERED") I CPT S SRCPTT=SRCPTT_", "_SRCPT D OMOD
Q
OMOD ; Other procedure CPT modifiers - file #136
N SRCMOD,SRCOMMA,X I $O(^SRO(136,SRTN,3,OTH,1,0)) D
.S (SRCOMMA,SRI)=0,SRCMOD="",SRCPTT=SRCPTT_"-" F S SRI=$O(^SRO(136,SRTN,3,OTH,1,SRI)) Q:'SRI D
..S SRM=$P(^SRO(136,SRTN,3,OTH,1,SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2)
..S SRCPTT=SRCPTT_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
Q
PMOD ; principle procedure CPT modifiers - file #136
N SRCMOD,SRCOMMA,X I $O(^SRO(136,SRTN,1,0)) D
.S (SRCOMMA,SRI)=0,SRCMOD="",SRCPTT=SRCPTT_"-" F S SRI=$O(^SRO(136,SRTN,1,SRI)) Q:'SRI D
..S SRM=$P(^SRO(136,SRTN,1,SRI,0),"^"),SRCMOD=$P($$MOD^ICPTMOD(SRM,"I"),"^",2)
..S SRCPTT=SRCPTT_$S(SRCOMMA:",",1:"")_SRCMOD,SRCOMMA=1
Q
LOOP ; break CPT line greater than 50 characters
S SROPT(M)="" F LOOP=1:1 S MM=$P(SRCPTT," "),MMM=$P(SRCPTT," ",2,200) Q:MMM="" Q:$L(SROPT(M))+$L(MM)'<50 S SROPT(M)=SROPT(M)_MM_" ",SRCPTT=MMM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROACC0 4662 printed Apr 09, 2024@21:42:46 Page 2
SROACC0 ;BIR/MAM - CPT ACCURACY SORT BY SPECIALTY ;05/13/99 2:33 PM
+1 ;;3.0; Surgery ;**50,88,142**;24 Jun 93
DEV WRITE !!,"This report is designed to use a 132 column format.",!!
+1 KILL IOP,%ZIS,POP,IO("Q")
SET %ZIS("A")="Select Device: "
SET %ZIS="QM"
DO ^%ZIS
IF POP
SET SRSOUT=1
GOTO END
+2 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="EN^SROACC0"
SET (ZTSAVE("SRSS"),ZTSAVE("SDATE*"),ZTSAVE("EDATE*"),ZTSAVE("SRCPT"),ZTSAVE("SRFLG"),ZTSAVE("SRSITE*"))=""
SET ZTDESC="REPORT TO CHECK CPT CODING ACCURACY"
DO ^%ZTLOAD
GOTO END
EN ; entry when queued
+1 KILL ^TMP("SR",$JOB)
USE IO
SET SRSOUT=0
SET SRPAGE=1
SET SRINST=SRSITE("SITE")
+2 NEW SRFRTO
SET Y=SDATE
XECUTE ^DD("DD")
SET SRFRTO="FROM: "_Y_" TO: "
SET Y=EDATE
XECUTE ^DD("DD")
SET SRFRTO=SRFRTO_Y
+3 IF SRCPT="ALL"
IF SRSS="ALL"
DO ^SROACC1
GOTO END
+4 IF SRCPT="ALL"
IF SRSS
DO ^SROACC2
GOTO END
+5 IF SRCPT
IF SRSS="ALL"
DO ^SROACC3
GOTO END
+6 DO ^SROACC4
END if $EXTRACT(IOST)="P"
WRITE @IOF
IF $DATA(ZTQUEUED)
KILL ^TMP("SR",$JOB)
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
WRITE @IOF
KILL SRTN
DO ^SRSKILL
+3 QUIT
HDR ; print heading
+1 IF SRHDR
IF $EXTRACT(IOST)'="P"
WRITE !!,"Press RETURN to continue, or '^' to quit: "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+2 if $Y
WRITE @IOF
WRITE !,?(132-$LENGTH(SRINST)\2),SRINST,?126,"PAGE",!,?58,"SURGICAL SERVICE",?126,$JUSTIFY(SRPAGE,4),!,?51,"REPORT OF CPT CODING ACCURACY",?100,"REVIEWED BY:"
+3 WRITE !
if SRSS'=""
WRITE ?(132-$LENGTH("FOR "_SRSS)\2),"FOR "_SRSS
WRITE ?100,"DATE REVIEWED:"
+4 WRITE !,?(132-$LENGTH(SRFRTO)\2),SRFRTO
+5 WRITE !,$SELECT(SRFLG=1:"O.R. SURGICAL PROCEDURES",SRFLG=2:"NON-O.R. PROCEDURES",1:"O.R. SURGICAL PROCEDURES AND NON-O.R. PROCEDURES")
+6 WRITE !!,?1,"PROCEDURE DATE",?20,"PATIENT",?60,"PROCEDURES",?111,"SURGEON/PROVIDER",!,?3,"CASE #",?22,"ID#",?111,"ATTEND SURG/PROV"
+7 SET SRHDR=1
SET SRPAGE=SRPAGE+1
QUIT
SPEC WRITE !!!,"Do you want to print the Report to Check Coding Accuracy for all",!,"Surgical Specialties ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
GOTO END
+1 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="Y"
+2 IF "YyNn"'[SRYN
WRITE !!,"Enter RETURN if you want to print the report for all specialties, or 'NO'",!,"to select a specific Surgical Specialty.",!!,"Press RETURN to continue "
READ X:DTIME
GOTO SPEC
+3 SET SRSS="ALL"
IF "Nn"[SRYN
WRITE !!
KILL DIC
SET DIC("S")="I '$P(^(0),""^"",3)"
SET DIC=137.45
SET DIC(0)="QEAMZ"
SET DIC("A")="Print the Coding Accuracy Report for which Surgical Specialty ? "
DO ^DIC
if Y<0
SET SRSOUT=1
if Y<0
GOTO END
SET SRSS=+Y
+4 DO DEV
QUIT
MSP IF SRFLG=3
SET SRSS="ALL"
GOTO DEV
+1 WRITE !!!,"Do you want to print the Report to Check Coding Accuracy for all",!,"Medical Specialties ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
GOTO END
+2 SET SRYN=$EXTRACT(SRYN)
if SRYN=""
SET SRYN="Y"
+3 IF "YyNn"'[SRYN
WRITE !!,"Enter RETURN if you want to print the report for all specialties, or 'NO'",!,"to select a specific Medical Specialty.",!!,"Press RETURN to continue "
READ X:DTIME
GOTO MSP
+4 SET SRSS="ALL"
IF "Nn"[SRYN
WRITE !!
KILL DIC
SET DIC=723
SET DIC(0)="QEAMZ"
SET DIC("A")="Print the Coding Accuracy Report for which Medical Specialty ? "
DO ^DIC
if Y<0
SET SRSOUT=1
if Y<0
GOTO END
SET SRSS=+Y
+5 DO DEV
+6 QUIT
OPER NEW CPT,SRCPT
KILL SROPERS,SRCPTT
SET SRX=^SRF(SRTN,"OP")
SET SROPER=$PIECE(SRX,"^")
+1 IF $ORDER(^SRF(SRTN,13,0))
SET SROPER=SROPER_", OTHER OPERATIONS: "
SET OTH=0
FOR
SET OTH=$ORDER(^SRF(SRTN,13,OTH))
if 'OTH
QUIT
DO OTHER
OPERT ; patch SR*3*142 changes
+1 SET CPT=$PIECE($GET(^SRO(136,SRTN,0)),"^",2)
SET SRCPT=$SELECT(CPT:$PIECE($$CPT^ICPTCOD(CPT),"^",2),1:"CPT NOT ENTERED")
SET SRCPTT="CPT Codes: "_SRCPT
IF CPT
DO PMOD
+2 IF $ORDER(^SRO(136,SRTN,3,0))
SET OTH=0
FOR
SET OTH=$ORDER(^SRO(136,SRTN,3,OTH))
if 'OTH
QUIT
DO OTHERT
+3 QUIT
OTHER ; other procedures
+1 SET SRLONG=1
SET SROPERS=$PIECE(^SRF(SRTN,13,OTH,0),"^")
+2 IF $LENGTH(SROPER)+$LENGTH(SROPERS)>250
SET SROPER=SROPER_" ..."
SET OTH=999
QUIT
+3 SET SROPER=SROPER_$SELECT(OTH=1:" ",1:", ")_SROPERS
+4 QUIT
OTHERT ; other procedures - file #136
+1 SET SRLONG=1
SET CPT=$PIECE($GET(^SRO(136,SRTN,3,OTH,0)),"^")
SET SRCPT=$SELECT(CPT:$PIECE($$CPT^ICPTCOD(CPT),"^",2),1:"CPT NOT ENTERED")
IF CPT
SET SRCPTT=SRCPTT_", "_SRCPT
DO OMOD
+2 QUIT
OMOD ; Other procedure CPT modifiers - file #136
+1 NEW SRCMOD,SRCOMMA,X
IF $ORDER(^SRO(136,SRTN,3,OTH,1,0))
Begin DoDot:1
+2 SET (SRCOMMA,SRI)=0
SET SRCMOD=""
SET SRCPTT=SRCPTT_"-"
FOR
SET SRI=$ORDER(^SRO(136,SRTN,3,OTH,1,SRI))
if 'SRI
QUIT
Begin DoDot:2
+3 SET SRM=$PIECE(^SRO(136,SRTN,3,OTH,1,SRI,0),"^")
SET SRCMOD=$PIECE($$MOD^ICPTMOD(SRM,"I"),"^",2)
+4 SET SRCPTT=SRCPTT_$SELECT(SRCOMMA:",",1:"")_SRCMOD
SET SRCOMMA=1
End DoDot:2
End DoDot:1
+5 QUIT
PMOD ; principle procedure CPT modifiers - file #136
+1 NEW SRCMOD,SRCOMMA,X
IF $ORDER(^SRO(136,SRTN,1,0))
Begin DoDot:1
+2 SET (SRCOMMA,SRI)=0
SET SRCMOD=""
SET SRCPTT=SRCPTT_"-"
FOR
SET SRI=$ORDER(^SRO(136,SRTN,1,SRI))
if 'SRI
QUIT
Begin DoDot:2
+3 SET SRM=$PIECE(^SRO(136,SRTN,1,SRI,0),"^")
SET SRCMOD=$PIECE($$MOD^ICPTMOD(SRM,"I"),"^",2)
+4 SET SRCPTT=SRCPTT_$SELECT(SRCOMMA:",",1:"")_SRCMOD
SET SRCOMMA=1
End DoDot:2
End DoDot:1
+5 QUIT
LOOP ; break CPT line greater than 50 characters
+1 SET SROPT(M)=""
FOR LOOP=1:1
SET MM=$PIECE(SRCPTT," ")
SET MMM=$PIECE(SRCPTT," ",2,200)
if MMM=""
QUIT
if $LENGTH(SROPT(M))+$LENGTH(MM)'<50
QUIT
SET SROPT(M)=SROPT(M)_MM_" "
SET SRCPTT=MMM
+2 QUIT
