- SROUNV2 ;B'HAM ISC/MAM - UNVERIFIED CASES (ALL SPECIALTIES) ; [ 07/27/98 2:33 PM ]
- ;;3.0; Surgery ;**50**;24 Jun 93
- U IO S SRSOUT=0 K ^TMP("SR",$J) S SRSDT=SDATE-.0001,SRSEDT=EDATE+.9999
- 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 $D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D UTIL
- S (SRSPEC,SRHDR)=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)) D HDR W !!,"No data for selected date range."
- 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 SR(0)=^SRF(SRTN,0),DFN=$P(SR(0),"^") D DEM^VADPT S SRSNM=VADM(1),Y=$P(SR(0),"^",9) D D^DIQ S SRSDATE=$E(Y,1,12)
- S SRSSN=VA("PID")
- S SROPER=$P(^SRF(SRTN,"OP"),"^"),SRCPT=$P(^("OP"),"^",2) I SRCPT="" S SROPER=SROPER_" * CPT CODE MISSING *"
- S SR(.1)=$S($D(^SRF(SRTN,.1)):^(.1),1:"")
- S SRSUR=$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))
- S SRATT=$P(SR(.1),"^",13) S:SRATT="" SRATT="NOT ENTERED" I SRATT S SRATT=$P(^VA(200,SRATT,0),"^") I $L(SRATT)>19 S SRATT=$P(SRATT,",")_", "_$E($P(SRATT,",",2))
- W !,SRSDATE,?20,SRSNM_" ("_SRTN_")",?60,SRSUR,!,?20,VA("PID"),?60,SRATT,!
- 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 !,?20,SROPS(1) I $D(SROPS(2)) W !,?20,SROPS(2) I $D(SROPS(3)) W !,?20,SROPS(3)
- W ! F LINE=1:1:80 W "-"
- Q
- UTIL ; set ^TMP("SR",$J)
- I $P($G(^SRF(SRTN,"VER")),"^")="Y" Q
- Q:'$D(^SRF(SRTN,.2)) S SR(.2)=^SRF(SRTN,.2) I $P(SR(.2),"^",12)="" Q
- I $D(^SRF(SRTN,31)),$P(^(31),"^",8)'="" Q
- I $D(^SRF(SRTN,30)),$P(^(30),"^")'="" Q
- S SR(0)=^SRF(SRTN,0),SRSPEC=$P(SR(0),"^",4),SRSPECN=$S(SRSPEC:$P(^SRO(137.45,SRSPEC,0),"^"),1:"UNKNOWN")
- 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
- W:$Y @IOF W !,?5,"List of Unverified Cases for "_SRSPEC,!!,"Operation Date",?20,"Patient (Case #)",?60,"Surgeon",!,?20,"Patient ID #",?60,"Attending Surgeon",! F LINE=1:1:80 W "="
- 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
- SROUNV2 ;B'HAM ISC/MAM - UNVERIFIED CASES (ALL SPECIALTIES) ; [ 07/27/98 2:33 PM ]
- +1 ;;3.0; Surgery ;**50**;24 Jun 93
- +2 USE IO
- SET SRSOUT=0
- KILL ^TMP("SR",$JOB)
- SET SRSDT=SDATE-.0001
- SET SRSEDT=EDATE+.9999
- +3 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 $DATA(^SRF(SRTN,0))
- IF $$MANDIV^SROUTL0(SRINSTP,SRTN)
- DO UTIL
- +4 SET (SRSPEC,SRHDR)=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
- +5 IF '$DATA(^TMP("SR",$JOB))
- DO HDR
- WRITE !!,"No data for selected date range."
- +6 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 SR(0)=^SRF(SRTN,0)
- SET DFN=$PIECE(SR(0),"^")
- DO DEM^VADPT
- SET SRSNM=VADM(1)
- SET Y=$PIECE(SR(0),"^",9)
- DO D^DIQ
- SET SRSDATE=$EXTRACT(Y,1,12)
- +3 SET SRSSN=VA("PID")
- +4 SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")
- SET SRCPT=$PIECE(^("OP"),"^",2)
- IF SRCPT=""
- SET SROPER=SROPER_" * CPT CODE MISSING *"
- +5 SET SR(.1)=$SELECT($DATA(^SRF(SRTN,.1)):^(.1),1:"")
- +6 SET SRSUR=$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))
- +7 SET SRATT=$PIECE(SR(.1),"^",13)
- IF SRATT=""
- SET SRATT="NOT ENTERED"
- IF SRATT
- SET SRATT=$PIECE(^VA(200,SRATT,0),"^")
- IF $LENGTH(SRATT)>19
- SET SRATT=$PIECE(SRATT,",")_", "_$EXTRACT($PIECE(SRATT,",",2))
- +8 WRITE !,SRSDATE,?20,SRSNM_" ("_SRTN_")",?60,SRSUR,!,?20,VA("PID"),?60,SRATT,!
- +9 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
- +10 WRITE !,?20,SROPS(1)
- IF $DATA(SROPS(2))
- WRITE !,?20,SROPS(2)
- IF $DATA(SROPS(3))
- WRITE !,?20,SROPS(3)
- +11 WRITE !
- FOR LINE=1:1:80
- WRITE "-"
- +12 QUIT
- UTIL ; set ^TMP("SR",$J)
- +1 IF $PIECE($GET(^SRF(SRTN,"VER")),"^")="Y"
- QUIT
- +2 IF '$DATA(^SRF(SRTN,.2))
- QUIT
- SET SR(.2)=^SRF(SRTN,.2)
- IF $PIECE(SR(.2),"^",12)=""
- QUIT
- +3 IF $DATA(^SRF(SRTN,31))
- IF $PIECE(^(31),"^",8)'=""
- QUIT
- +4 IF $DATA(^SRF(SRTN,30))
- IF $PIECE(^(30),"^")'=""
- QUIT
- +5 SET SR(0)=^SRF(SRTN,0)
- SET SRSPEC=$PIECE(SR(0),"^",4)
- SET SRSPECN=$SELECT(SRSPEC:$PIECE(^SRO(137.45,SRSPEC,0),"^"),1:"UNKNOWN")
- +6 SET ^TMP("SR",$JOB,SRSPECN,SRSDT,SRTN)=""
- +7 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 IF $Y
- WRITE @IOF
- WRITE !,?5,"List of Unverified Cases for "_SRSPEC,!!,"Operation Date",?20,"Patient (Case #)",?60,"Surgeon",!,?20,"Patient ID #",?60,"Attending Surgeon",!
- FOR LINE=1:1:80
- WRITE "="
- +4 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
