- 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 Jan 18, 2025@03:41:09 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