- SRSCPT2 ;BIR/MAM - MISSING CPTS (ALL SPECIALTIES) ;03/29/06
- ;;3.0; Surgery ;**59,50,88,142,144**;24 Jun 93
- ;
- ; Reference to ^ECC(723 supported by DBIA #205
- ;
- F S SRSDT=$O(^SRF("AC",SRSDT)) Q:'SRSDT!(SRSDT>SRSEDT) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN I $P($G(^SRF(SRTN,30)),"^")="",$D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN) D UTIL
- S (SRSPEC,SRHDR,SRSOUT)=0 F S SRSPEC=$O(^TMP("SR",$J,SRSPEC)) Q:SRSPEC=""!(SRSOUT) D HDR S SRHDR=1 S SRSDT=0 F S SRSDT=$O(^TMP("SR",$J,SRSPEC,SRSDT)) Q:'SRSDT!(SRSOUT) D CASE
- I '$D(^TMP("SR",$J)) S SRSPEC="" D HDR W $$NODATA^SROUTL0()
- Q
- CASE ; get case number
- S SRTN=0 F S SRTN=$O(^TMP("SR",$J,SRSPEC,SRSDT,SRTN)) Q:'SRTN!(SRSOUT) K SR,SROP D SET
- Q
- SET ; set variables & print info
- I $Y+8>IOSL D HDR I SRSOUT Q
- S SRNON=0 I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SRNON=1
- S SR(0)=^SRF(SRTN,0),DFN=+SR(0) D DEM^VADPT S SRSNM=VADM(1),SRSSN=VA("PID"),Y=$P(SR(0),"^",9) D D^DIQ S SRSDATE=$E(Y,1,12) I $L(SRSNM)>23 S SRSNM=$P(VADM(1),",")_","_$E($P(VADM(1),",",2))_"."
- S SROP(1)=$P(^SRF(SRTN,"OP"),"^")
- S CNT=1,OP=0 F S OP=$O(^SRF(SRTN,13,OP)) Q:'OP D
- .S CNT=CNT+1,SROP(CNT)=$P(^SRF(SRTN,13,OP,0),"^")
- S SR(.1)=$S($D(^SRF(SRTN,.1)):^(.1),1:"")
- S SRSUR=$S(SRNON:$P(^SRF(SRTN,"NON"),"^",6),1:$P(SR(.1),"^",4)) S:SRSUR="" SRSUR="NOT ENTERED" I SRSUR S SRSUR=$P(^VA(200,SRSUR,0),"^") I $L(SRSUR)>19 S SRSUR=$P(SRSUR,",")_","_$E($P(SRSUR,",",2))_"."
- W !,SRSDATE,?18,SRSNM_" ("_VA("PID")_")",?60,SRSUR,!,SRTN W:SRFLG=3&(SRNON) !,"NON-O.R."
- S CNT=0 F S CNT=$O(SROP(CNT)) Q:'CNT S SROPER="* "_SROP(CNT) D OPS
- W ! F LINE=1:1:80 W "-"
- Q
- UTIL ; set ^TMP("SR",$J)
- 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 Q:'SRNON
- S SRMISS=0 I '$P($G(^SRO(136,SRTN,0)),"^",2) S SRMISS=1
- I 'SRMISS Q
- UT I SRNON S SRSPEC=$P(^SRF(SRTN,"NON"),"^",8),SRSPECN=$S(SRSPEC:$P(^ECC(723,SRSPEC,0),"^"),1:"UNKNOWN")
- I 'SRNON S SRSPEC=$P(^SRF(SRTN,0),"^",4),SRSPECN=$S('SRSPEC:"UNKNOWN",1:$P(^SRO(137.45,SRSPEC,0),"^"))
- S ^TMP("SR",$J,SRSPECN,SRSDT,SRTN)=""
- Q
- HDR ; print heading
- I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
- I SRHDR,$E(IOST)'="P" W !!,"Press RETURN to continue, or '^' to quit:. " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
- S SRTITLE=$S(SRFLG=1:"O.R. Surgical Procedures",SRFLG=2:"Non-O.R. Procedures",1:"O.R. Surgical and Non-O.R. Procedures")
- W:$Y @IOF W !,?(80-$L(SRINST)\2),SRINST,!,?23,"Completed Cases Missing CPT Codes",!,?(80-$L(SRTITLE)\2),SRTITLE,!,?(80-$L(SRFRTO)\2),SRFRTO
- W:SRSPEC'="" !,?(80-$L("Specialty: "_SRSPEC)\2),"Specialty: "_SRSPEC W !!,"Operation Date",?18,"Patient (ID#)",?60,"Surgeon/Provider",!,"Case #",! F LINE=1:1:80 W "="
- Q
- OPS ; print operations
- K SROPS,MM,MMM S:$L(SROPER)<60 SROPS(1)=SROPER I $L(SROPER)>59 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
- W !,?18,SROPS(1) I $D(SROPS(2)) W !,?18,SROPS(2) I $D(SROPS(3)) W !,?18,SROPS(3) I $D(SROPS(4)) W !,?18,SROPS(4)
- Q
- LOOP ; break procedure if greater than 59 characters
- S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<60 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRSCPT2 3193 printed Feb 19, 2025@00:13:54 Page 2
- SRSCPT2 ;BIR/MAM - MISSING CPTS (ALL SPECIALTIES) ;03/29/06
- +1 ;;3.0; Surgery ;**59,50,88,142,144**;24 Jun 93
- +2 ;
- +3 ; Reference to ^ECC(723 supported by DBIA #205
- +4 ;
- +5 FOR
- SET SRSDT=$ORDER(^SRF("AC",SRSDT))
- if 'SRSDT!(SRSDT>SRSEDT)
- QUIT
- SET SRTN=0
- FOR
- SET SRTN=$ORDER(^SRF("AC",SRSDT,SRTN))
- if 'SRTN
- QUIT
- IF $PIECE($GET(^SRF(SRTN,30)),"^")=""
- IF $DATA(^SRF(SRTN,0))
- IF $$DIV^SROUTL0(SRTN)
- DO UTIL
- +6 SET (SRSPEC,SRHDR,SRSOUT)=0
- FOR
- SET SRSPEC=$ORDER(^TMP("SR",$JOB,SRSPEC))
- if SRSPEC=""!(SRSOUT)
- QUIT
- DO HDR
- SET SRHDR=1
- SET SRSDT=0
- FOR
- SET SRSDT=$ORDER(^TMP("SR",$JOB,SRSPEC,SRSDT))
- if 'SRSDT!(SRSOUT)
- QUIT
- DO CASE
- +7 IF '$DATA(^TMP("SR",$JOB))
- SET SRSPEC=""
- DO HDR
- WRITE $$NODATA^SROUTL0()
- +8 QUIT
- CASE ; get case number
- +1 SET SRTN=0
- FOR
- SET SRTN=$ORDER(^TMP("SR",$JOB,SRSPEC,SRSDT,SRTN))
- if 'SRTN!(SRSOUT)
- QUIT
- KILL SR,SROP
- DO SET
- +2 QUIT
- SET ; set variables & print info
- +1 IF $Y+8>IOSL
- DO HDR
- IF SRSOUT
- QUIT
- +2 SET SRNON=0
- IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"
- SET SRNON=1
- +3 SET SR(0)=^SRF(SRTN,0)
- SET DFN=+SR(0)
- DO DEM^VADPT
- SET SRSNM=VADM(1)
- SET SRSSN=VA("PID")
- SET Y=$PIECE(SR(0),"^",9)
- DO D^DIQ
- SET SRSDATE=$EXTRACT(Y,1,12)
- IF $LENGTH(SRSNM)>23
- SET SRSNM=$PIECE(VADM(1),",")_","_$EXTRACT($PIECE(VADM(1),",",2))_"."
- +4 SET SROP(1)=$PIECE(^SRF(SRTN,"OP"),"^")
- +5 SET CNT=1
- SET OP=0
- FOR
- SET OP=$ORDER(^SRF(SRTN,13,OP))
- if 'OP
- QUIT
- Begin DoDot:1
- +6 SET CNT=CNT+1
- SET SROP(CNT)=$PIECE(^SRF(SRTN,13,OP,0),"^")
- End DoDot:1
- +7 SET SR(.1)=$SELECT($DATA(^SRF(SRTN,.1)):^(.1),1:"")
- +8 SET SRSUR=$SELECT(SRNON:$PIECE(^SRF(SRTN,"NON"),"^",6),1:$PIECE(SR(.1),"^",4))
- if SRSUR=""
- SET SRSUR="NOT ENTERED"
- IF SRSUR
- SET SRSUR=$PIECE(^VA(200,SRSUR,0),"^")
- IF $LENGTH(SRSUR)>19
- SET SRSUR=$PIECE(SRSUR,",")_","_$EXTRACT($PIECE(SRSUR,",",2))_"."
- +9 WRITE !,SRSDATE,?18,SRSNM_" ("_VA("PID")_")",?60,SRSUR,!,SRTN
- if SRFLG=3&(SRNON)
- WRITE !,"NON-O.R."
- +10 SET CNT=0
- FOR
- SET CNT=$ORDER(SROP(CNT))
- if 'CNT
- QUIT
- SET SROPER="* "_SROP(CNT)
- DO OPS
- +11 WRITE !
- FOR LINE=1:1:80
- WRITE "-"
- +12 QUIT
- UTIL ; set ^TMP("SR",$J)
- +1 SET SRNON=0
- IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"
- SET SRNON=1
- +2 IF SRFLG=1!(SRFLG=3&('SRNON))
- if $PIECE($GET(^SRF(SRTN,.2)),"^",12)=""
- QUIT
- +3 IF SRFLG=2
- if 'SRNON
- QUIT
- +4 SET SRMISS=0
- IF '$PIECE($GET(^SRO(136,SRTN,0)),"^",2)
- SET SRMISS=1
- +5 IF 'SRMISS
- QUIT
- UT IF SRNON
- SET SRSPEC=$PIECE(^SRF(SRTN,"NON"),"^",8)
- SET SRSPECN=$SELECT(SRSPEC:$PIECE(^ECC(723,SRSPEC,0),"^"),1:"UNKNOWN")
- +1 IF 'SRNON
- SET SRSPEC=$PIECE(^SRF(SRTN,0),"^",4)
- SET SRSPECN=$SELECT('SRSPEC:"UNKNOWN",1:$PIECE(^SRO(137.45,SRSPEC,0),"^"))
- +2 SET ^TMP("SR",$JOB,SRSPECN,SRSDT,SRTN)=""
- +3 QUIT
- HDR ; print heading
- +1 IF $DATA(ZTQUEUED)
- DO ^SROSTOP
- IF SRHALT
- SET SRSOUT=1
- QUIT
- +2 IF SRHDR
- IF $EXTRACT(IOST)'="P"
- WRITE !!,"Press RETURN to continue, or '^' to quit:. "
- READ X:DTIME
- IF '$TEST!(X["^")
- SET SRSOUT=1
- QUIT
- +3 SET SRTITLE=$SELECT(SRFLG=1:"O.R. Surgical Procedures",SRFLG=2:"Non-O.R. Procedures",1:"O.R. Surgical and Non-O.R. Procedures")
- +4 if $Y
- WRITE @IOF
- WRITE !,?(80-$LENGTH(SRINST)\2),SRINST,!,?23,"Completed Cases Missing CPT Codes",!,?(80-$LENGTH(SRTITLE)\2),SRTITLE,!,?(80-$LENGTH(SRFRTO)\2),SRFRTO
- +5 if SRSPEC'=""
- WRITE !,?(80-$LENGTH("Specialty: "_SRSPEC)\2),"Specialty: "_SRSPEC
- WRITE !!,"Operation Date",?18,"Patient (ID#)",?60,"Surgeon/Provider",!,"Case #",!
- FOR LINE=1:1:80
- WRITE "="
- +6 QUIT
- OPS ; print operations
- +1 KILL SROPS,MM,MMM
- if $LENGTH(SROPER)<60
- SET SROPS(1)=SROPER
- IF $LENGTH(SROPER)>59
- SET SROPER=SROPER_" "
- FOR M=1:1
- DO LOOP
- if MMM=""
- QUIT
- +2 WRITE !,?18,SROPS(1)
- IF $DATA(SROPS(2))
- WRITE !,?18,SROPS(2)
- IF $DATA(SROPS(3))
- WRITE !,?18,SROPS(3)
- IF $DATA(SROPS(4))
- WRITE !,?18,SROPS(4)
- +3 QUIT
- LOOP ; break procedure if greater than 59 characters
- +1 SET SROPS(M)=""
- FOR LOOP=1:1
- SET MM=$PIECE(SROPER," ")
- SET MMM=$PIECE(SROPER," ",2,200)
- if MMM=""
- QUIT
- if $LENGTH(SROPS(M))+$LENGTH(MM)'<60
- QUIT
- SET SROPS(M)=SROPS(M)_MM_" "
- SET SROPER=MMM
- +2 QUIT