SRONON ;B'HAM ISC/ADM - NON-O.R. PROCEDURE REPORT ; [ 02/18/04 9:55 AM ]
;;3.0; Surgery ;**48,77,100**;24 Jun 93
;
;** NOTICE: This routine is part of an implementation of a nationally
;** controlled procedure. Local modifications to this routine
;** are prohibited.
;
I '$D(SRSITE) D ^SROVAR G:'$D(SRSITE) END S SRSITE("KILL")=1
I '$D(SRTN) D NON G:'$D(SRTN) END S SRTN("KILL")=1
N SREXP,SRSINED,SRDTITL,SRSTAT,SRTIU
S SRDTITL="Procedure Report"
S SRSINED=0,SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",3)
I SRTIU S SRSTAT=$$STATUS^SROESUTL(SRTIU) S:SRSTAT=7 SRSINED=1
D DISPLY,END
Q
DISPLY I SRSINED S SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",3) I SRTIU D PRNT^SROESPR(SRTN,SRTIU,SRDTITL) Q
I 'SRSINED S SREXP=$P($G(^SRF(SRTN,"TIU")),"^",5) D D LAST
.I 'SREXP W !!," * * A Procedure Report (Non-OR) will not be created for this procedure. * *" Q
.W !!," * * A Procedure Report (Non-OR) is not available. * *"
Q
END W @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
D ^SRSKILL K VAIN,VAINDT I $D(SRSITE("KILL")) K SRSITE
I $D(SRTN("KILL")) K SRTN
Q
NON K DIC S DIC("A")="Select Patient: ",DIC=2,DIC(0)="QEAMZ" D ^DIC I Y<0 S SRSOUT=1 G END
S DFN=+Y D DEM^VADPT S SRNM=VADM(1)
W @IOF,!,"Non-O.R. Procedures for "_SRNM_" ("_VA("PID")_")" I $D(^DPT(DFN,.35)) S Y=$P(^(.35),"^") I Y D D^DIQ S Y=$P(Y,"@")_" "_$P(Y,"@",2) W !," (DIED ON "_Y_")"
W !! S (SROP,CNT)=0 F I=0:0 S SROP=$O(^SRF("ANOR",DFN,SROP)) Q:'SROP D LIST
SEL W !!!,"Select Procedure: " R X:DTIME I '$T!("^"[X) G END
I '$D(SRCASE(X)) W !!,"Enter the number corresponding to the procedure for which you want to print",!,"a report." G SEL
S SRTN=+SRCASE(X)
Q
LIST ; list case
I $Y+5>IOSL S SRBACK=0 D SEL^SROPER Q:$D(SRTN)!(SRSOUT) W @IOF,!,?1,"NON-O.R. PROCEDURES FOR "_VADM(1)_" ("_VA("PID")_")",! I SRBACK S CNT=0,SROP=SRCASE(1)-1,SRDT=$P(SRCASE(1),"^",2)
S CNT=CNT+1,SRSDATE=$P(^SRF(SROP,0),"^",9),SROPER=$P(^SRF(SROP,"OP"),"^"),SRCASE(CNT)=SROP
K SROPS,MM,MMM S:$L(SROPER)<55 SROPS(1)=SROPER I $L(SROPER)>54 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
S Y=SRSDATE D D^DIQ S SRSDATE=$P(Y,"@")_" "_$P(Y,"@",2)
W !,CNT_".",?4,SRSDATE,?25,SROPS(1) I $D(SROPS(2)) W !,?25,SROPS(2) I $D(SROPS(3)) W !,?25,SROPS(3) I $D(SROPS(4)) W !,?25,SROPS(4)
W !
Q
LOOP ; break procedure if greater than 55 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)'<55 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
LAST W ! K DIR S DIR(0)="E" D ^DIR K DIR
Q
CODE ; entry point from coding menu
N SREXP,SRSINED,SRDTITL,SRSTAT,SRTIU
S SRDTITL="Procedure Report"
S SRSINED=0,SRTIU=$P($G(^SRF(SRTN,"TIU")),"^",3)
I SRTIU S SRSTAT=$$STATUS^SROESUTL(SRTIU) S:SRSTAT=7 SRSINED=1
D DISPLY,END
Q
SRONON ;B'HAM ISC/ADM - NON-O.R. PROCEDURE REPORT ; [ 02/18/04 9:55 AM ]
+1 ;;3.0; Surgery ;**48,77,100**;24 Jun 93
+2 ;
+3 ;** NOTICE: This routine is part of an implementation of a nationally
+4 ;** controlled procedure. Local modifications to this routine
+5 ;** are prohibited.
+6 ;
+7 IF '$DATA(SRSITE)
DO ^SROVAR
IF '$DATA(SRSITE)
GOTO END
SET SRSITE("KILL")=1
+8 IF '$DATA(SRTN)
DO NON
IF '$DATA(SRTN)
GOTO END
SET SRTN("KILL")=1
+9 NEW SREXP,SRSINED,SRDTITL,SRSTAT,SRTIU
+10 SET SRDTITL="Procedure Report"
+11 SET SRSINED=0
SET SRTIU=$PIECE($GET(^SRF(SRTN,"TIU")),"^",3)
+12 IF SRTIU
SET SRSTAT=$$STATUS^SROESUTL(SRTIU)
IF SRSTAT=7
SET SRSINED=1
+13 DO DISPLY
DO END
+14 QUIT
DISPLY IF SRSINED
SET SRTIU=$PIECE($GET(^SRF(SRTN,"TIU")),"^",3)
IF SRTIU
DO PRNT^SROESPR(SRTN,SRTIU,SRDTITL)
QUIT
+1 IF 'SRSINED
SET SREXP=$PIECE($GET(^SRF(SRTN,"TIU")),"^",5)
Begin DoDot:1
+2 IF 'SREXP
WRITE !!," * * A Procedure Report (Non-OR) will not be created for this procedure. * *"
QUIT
+3 WRITE !!," * * A Procedure Report (Non-OR) is not available. * *"
End DoDot:1
DO LAST
+4 QUIT
END WRITE @IOF
IF $DATA(ZTQUEUED)
IF $GET(ZTSTOP)
QUIT
SET ZTREQ="@"
QUIT
+1 DO ^SRSKILL
KILL VAIN,VAINDT
IF $DATA(SRSITE("KILL"))
KILL SRSITE
+2 IF $DATA(SRTN("KILL"))
KILL SRTN
+3 QUIT
NON KILL DIC
SET DIC("A")="Select Patient: "
SET DIC=2
SET DIC(0)="QEAMZ"
DO ^DIC
IF Y<0
SET SRSOUT=1
GOTO END
+1 SET DFN=+Y
DO DEM^VADPT
SET SRNM=VADM(1)
+2 WRITE @IOF,!,"Non-O.R. Procedures for "_SRNM_" ("_VA("PID")_")"
IF $DATA(^DPT(DFN,.35))
SET Y=$PIECE(^(.35),"^")
IF Y
DO D^DIQ
SET Y=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
WRITE !," (DIED ON "_Y_")"
+3 WRITE !!
SET (SROP,CNT)=0
FOR I=0:0
SET SROP=$ORDER(^SRF("ANOR",DFN,SROP))
IF 'SROP
QUIT
DO LIST
SEL WRITE !!!,"Select Procedure: "
READ X:DTIME
IF '$TEST!("^"[X)
GOTO END
+1 IF '$DATA(SRCASE(X))
WRITE !!,"Enter the number corresponding to the procedure for which you want to print",!,"a report."
GOTO SEL
+2 SET SRTN=+SRCASE(X)
+3 QUIT
LIST ; list case
+1 IF $Y+5>IOSL
SET SRBACK=0
DO SEL^SROPER
IF $DATA(SRTN)!(SRSOUT)
QUIT
WRITE @IOF,!,?1,"NON-O.R. PROCEDURES FOR "_VADM(1)_" ("_VA("PID")_")",!
IF SRBACK
SET CNT=0
SET SROP=SRCASE(1)-1
SET SRDT=$PIECE(SRCASE(1),"^",2)
+2 SET CNT=CNT+1
SET SRSDATE=$PIECE(^SRF(SROP,0),"^",9)
SET SROPER=$PIECE(^SRF(SROP,"OP"),"^")
SET SRCASE(CNT)=SROP
+3 KILL SROPS,MM,MMM
IF $LENGTH(SROPER)<55
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>54
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
IF MMM=""
QUIT
+4 SET Y=SRSDATE
DO D^DIQ
SET SRSDATE=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
+5 WRITE !,CNT_".",?4,SRSDATE,?25,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?25,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?25,SROPS(3)
IF $DATA(SROPS(4))
WRITE !,?25,SROPS(4)
+6 WRITE !
+7 QUIT
LOOP ; break procedure if greater than 55 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)'<55
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
LAST WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+1 QUIT
CODE ; entry point from coding menu
+1 NEW SREXP,SRSINED,SRDTITL,SRSTAT,SRTIU
+2 SET SRDTITL="Procedure Report"
+3 SET SRSINED=0
SET SRTIU=$PIECE($GET(^SRF(SRTN,"TIU")),"^",3)
+4 IF SRTIU
SET SRSTAT=$$STATUS^SROESUTL(SRTIU)
IF SRSTAT=7
SET SRSINED=1
+5 DO DISPLY
DO END
+6 QUIT
