SROGTSR ;WASH/GEK,BIR/ADM - IMAGING: SURGERY CASE LIST ; [ 05/08/97 6:11 AM ]
;;3.0; Surgery ;**66,89**;24 Jun 93
ERRA ; Error trap
S SRGY(0)="0^ERROR "_$$EC^%ZOSV
D @^%ZOSF("ERRTN")
Q
GET(SRGY,SRDFN) ;
N CNT,DFN,J,K,LOOP,M,MM,MMM,SR,SRDT,SRIMAGE,SRIMCNT,SRLONG,SROP,SROPER,SROPERS,SROPS,SROTHER,SRSCAN,SRSDATE,SRSOUT,SRSTAT,SRSTATUS,SRTOT,X,Y
S X="ERRA^SROGTSR",@^%ZOSF("TRAP")
S DFN=+SRDFN
S SRSOUT=0
S (SRDT,SRTOT)=0,CNT=2 F S SRDT=$O(^SRF("ADT",DFN,SRDT)) Q:'SRDT!(SRSOUT) S SROP=0 F S SROP=$O(^SRF("ADT",DFN,SRDT,SROP)) Q:'SROP!(SRSOUT) D LIST
I '$D(SRGY(2)) S SRGY(0)="0^There are no cases entered" Q
S SRGY(0)=SRTOT_"^Case"_$S(SRTOT=1:"",1:"s")_" found"
S SRGY(1)="#^Date^Case description"
Q
LIST ; list cases
I $P($G(^SRF(SROP,"NON")),"^")="Y" Q
S SRSCAN=1 I $D(^SRF(SROP,.2)),$P(^(.2),"^",12)'="" K SRSCAN
I $D(SRSCAN),$D(^SRF(SROP,30)),$P(^(30),"^") Q
I $D(SRSCAN),$D(^SRF(SROP,31)),$P(^(31),"^",8) Q
I $D(^SRF(SROP,37)),$P(^(37),"^") Q
S SRSDATE=$P(^SRF(SROP,0),"^",9)
S SRTOT=SRTOT+1,SRGY(CNT)=SRTOT_U_$E(SRSDATE,4,5)_"-"_$E(SRSDATE,6,7)_"-"_($E(SRSDATE,1,3)+1700)_U
S SROPER=$P(^SRF(SROP,"OP"),"^") I $O(^SRF(SROP,13,0)) S SROTHER=0 F I=0:0 S SROTHER=$O(^SRF(SROP,13,SROTHER)) Q:'SROTHER D OTHER
D ^SROP1 K SROPS,MM,MMM S:$L(SROPER)<65 SROPS(1)=SROPER I $L(SROPER)>64 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
S (SRIMCNT,SRIMAGE)=0 F S SRIMAGE=$O(^SRF(SROP,2005,SRIMAGE)) Q:'SRIMAGE S SRIMCNT=SRIMCNT+1
S SRGY(CNT)=SRGY(CNT)_SROPS(1)_U_SROP_U_SRSDATE_U_SRIMCNT,CNT=CNT+1
S J=2 F Q:'$D(SROPS(J)) S SRGY(CNT)="^^"_SROPS(J),J=J+1,CNT=CNT+1
Q
OTHER ; other operations
S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SROP,13,SROTHER,0),"^"))>235 S SRLONG=0,SROTHER=999,SROPERS=" ..."
I SRLONG S SROPERS=$P(^SRF(SROP,13,SROTHER,0),"^")
S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
Q
LOOP ; break procedure
S SROPS(M)="" F LOOP=1:1 S MM=$P(SROPER," "),MMM=$P(SROPER," ",2,200) Q:MMM="" Q:$L(SROPS(M))+$L(MM)'<65 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROGTSR 2043 printed Oct 16, 2024@18:44:30 Page 2
SROGTSR ;WASH/GEK,BIR/ADM - IMAGING: SURGERY CASE LIST ; [ 05/08/97 6:11 AM ]
+1 ;;3.0; Surgery ;**66,89**;24 Jun 93
ERRA ; Error trap
+1 SET SRGY(0)="0^ERROR "_$$EC^%ZOSV
+2 DO @^%ZOSF("ERRTN")
+3 QUIT
GET(SRGY,SRDFN) ;
+1 NEW CNT,DFN,J,K,LOOP,M,MM,MMM,SR,SRDT,SRIMAGE,SRIMCNT,SRLONG,SROP,SROPER,SROPERS,SROPS,SROTHER,SRSCAN,SRSDATE,SRSOUT,SRSTAT,SRSTATUS,SRTOT,X,Y
+2 SET X="ERRA^SROGTSR"
SET @^%ZOSF("TRAP")
+3 SET DFN=+SRDFN
+4 SET SRSOUT=0
+5 SET (SRDT,SRTOT)=0
SET CNT=2
FOR
SET SRDT=$ORDER(^SRF("ADT",DFN,SRDT))
if 'SRDT!(SRSOUT)
QUIT
SET SROP=0
FOR
SET SROP=$ORDER(^SRF("ADT",DFN,SRDT,SROP))
if 'SROP!(SRSOUT)
QUIT
DO LIST
+6 IF '$DATA(SRGY(2))
SET SRGY(0)="0^There are no cases entered"
QUIT
+7 SET SRGY(0)=SRTOT_"^Case"_$SELECT(SRTOT=1:"",1:"s")_" found"
+8 SET SRGY(1)="#^Date^Case description"
+9 QUIT
LIST ; list cases
+1 IF $PIECE($GET(^SRF(SROP,"NON")),"^")="Y"
QUIT
+2 SET SRSCAN=1
IF $DATA(^SRF(SROP,.2))
IF $PIECE(^(.2),"^",12)'=""
KILL SRSCAN
+3 IF $DATA(SRSCAN)
IF $DATA(^SRF(SROP,30))
IF $PIECE(^(30),"^")
QUIT
+4 IF $DATA(SRSCAN)
IF $DATA(^SRF(SROP,31))
IF $PIECE(^(31),"^",8)
QUIT
+5 IF $DATA(^SRF(SROP,37))
IF $PIECE(^(37),"^")
QUIT
+6 SET SRSDATE=$PIECE(^SRF(SROP,0),"^",9)
+7 SET SRTOT=SRTOT+1
SET SRGY(CNT)=SRTOT_U_$EXTRACT(SRSDATE,4,5)_"-"_$EXTRACT(SRSDATE,6,7)_"-"_($EXTRACT(SRSDATE,1,3)+1700)_U
+8 SET SROPER=$PIECE(^SRF(SROP,"OP"),"^")
IF $ORDER(^SRF(SROP,13,0))
SET SROTHER=0
FOR I=0:0
SET SROTHER=$ORDER(^SRF(SROP,13,SROTHER))
if 'SROTHER
QUIT
DO OTHER
+9 DO ^SROP1
KILL SROPS,MM,MMM
if $LENGTH(SROPER)<65
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>64
SET SROPER=SROPER_" "
FOR M=1:1
DO LOOP
if MMM=""
QUIT
+10 SET (SRIMCNT,SRIMAGE)=0
FOR
SET SRIMAGE=$ORDER(^SRF(SROP,2005,SRIMAGE))
if 'SRIMAGE
QUIT
SET SRIMCNT=SRIMCNT+1
+11 SET SRGY(CNT)=SRGY(CNT)_SROPS(1)_U_SROP_U_SRSDATE_U_SRIMCNT
SET CNT=CNT+1
+12 SET J=2
FOR
if '$DATA(SROPS(J))
QUIT
SET SRGY(CNT)="^^"_SROPS(J)
SET J=J+1
SET CNT=CNT+1
+13 QUIT
OTHER ; other operations
+1 SET SRLONG=1
IF $LENGTH(SROPER)+$LENGTH($PIECE(^SRF(SROP,13,SROTHER,0),"^"))>235
SET SRLONG=0
SET SROTHER=999
SET SROPERS=" ..."
+2 IF SRLONG
SET SROPERS=$PIECE(^SRF(SROP,13,SROTHER,0),"^")
+3 SET SROPER=SROPER_$SELECT(SROPERS=" ...":SROPERS,1:", "_SROPERS)
+4 QUIT
LOOP ; break procedure
+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)'<65
QUIT
SET SROPS(M)=SROPS(M)_MM_" "
SET SROPER=MMM
+2 QUIT
