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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROUNV2 2655 printed Oct 16, 2024@18:47:03 Page 2
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
