SROASWP3 ;B'HAM ISC/MAM - MANUAL MATCH RISK DATA ; 14 APR 1992 11:15 am
;;3.0; Surgery ;;24 Jun 93
S SRA(0)=^SRA(SRAN,0),DFN=$P(SRA(0),"^"),(SDATE,X1)=$P(SRA(0),"^",5),X2=60 D C^%DTC S SRUPPER=X,X2=-60,X1=SDATE D C^%DTC S SRLOWER=X
D DEM^VADPT S SRNAME=VADM(1) K VADM
S SROPER=$P(^SRA(SRAN,"OP"),"^") K SROPS S:$L(SROPER)<65 SROPS(1)=SROPER I $L(SROPER)>64 S SROPER=SROPER_" " K M,MM,MMM F M=1:1 D LOOP Q:MMM=""
W @IOF,!,"PATIENT: "_SRNAME,?50,"DATE OF OPERATION: "_$E(SDATE,4,5)_"/"_$E(SDATE,6,7)_"/"_$E(SDATE,2,3),!,"ASSESSMENT NUMBER: "_SRAN,!,"PROCEDURE: "_SROPS(1) I $D(SROPS(2)) W !,?12,SROPS(2) I $D(SROPS(3)) W !,?12,SROPS(3)
W ! F LINE=1:1:80 W "-"
W ! K SRCASE S (SRTN,CNT)=0 F S SRTN=$O(^SRF("B",DFN,SRTN)) Q:'SRTN D CHECK I CASE S SROP=SRTN D LIST
I '$D(SRCASE(1)) W !!,"There were no Surgery cases for "_SRNAME_" within the 60 days before",!,"or after the date of operation entered in this assessment." D DELETE Q
I '$D(SRCASE(2)) D ONLYONE Q
W !! F LINE=1:1:80 W "-"
SEL W !!,"Select the NUMBER corresponding to the ",!,"Surgery Case that this Assessment matches: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
I X="" D DELETE S:SRSOUT SRSOUT=0 Q
I '$D(SRCASE(X)) W !!,"Enter the number that corresponds to the Surgery case that this assessment ",!,"matches. If the assessment does not relate to any of the cases listed above,",!,"enter RETURN at the prompt." G SEL
MATCH W !!,"Are you sure that this is the correct Surgery Case ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter 'YES' to convert the assessemnt into the Surgery file, or 'NO' to make",!,"another selection." G MATCH
I "Yy"[SRYN S OK=1,SRTN=SRCASE(X) W !!,"Converting Risk Assessment Information..."
Q
CHECK ; check for dates within 60 days of procedure
S CASE=0,SRSDATE=$P(^SRF(SRTN,0),"^",9)
I SRSDATE<SRLOWER Q
I SRSDATE>SRUPPER Q
S CASE=1
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 CNT=CNT+1,SRSDATE=$P(^SRF(SROP,0),"^",9)
W !,CNT_". "
CASE W $E(SRSDATE,4,5)_"-"_$E(SRSDATE,6,7)_"-"_$E(SRSDATE,2,3)
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=""
W ?14,SROPS(1) I $D(SROPS(2)) W !,?14,SROPS(2) I $D(SROPS(3)) W !,?14,SROPS(3) W:$D(SROPS(4)) !,?14,SROPS(4)
W ! S SRCASE(CNT)=SROP
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 procedures
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
ONLYONE ; match if only one case
W !!,"Do you want to match the Risk Assessment with this Surgical Case ? NO// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
S SRYN=$E(SRYN) I "YyNn"'[SRYN W !!,"Enter 'YES' to move the Risk Assessment information into this surgical case,",!,"or 'NO' if the information does not relate to this surgical case." G ONLYONE
I "Nn"'[SRYN S SRTN=SRCASE(1),OK=1 W !!,"Converting Risk Assessment Information..." Q
DELETE ; delete assessment
W !!,"Since this assessment cannot be matched to any Surgery case, it must be",!,"deleted.",!!,"Are you sure that you want to delete this assessment ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 Q
S SRYN=$E(SRYN) I SRYN="" S SRYN="Y"
I "YyNn"'[SRYN W !!,"Enter 'YES' to delete this assessment from the SURGERY RISK ASSESSMENT",!,"file (139), or 'NO' to continue matching other assessments." G DELETE
I "Yy"'[SRYN Q
K DA,DIK S DA=SRAN,DIK="^SRA(" W !!,"Deleting assessment from SURGERY RISK ASSESSMENT file (139)..." D ^DIK
W !!,"Press RETURN to continue " R X:DTIME
Q
SROASWP3 ;B'HAM ISC/MAM - MANUAL MATCH RISK DATA ; 14 APR 1992 11:15 am
+1 ;;3.0; Surgery ;;24 Jun 93
+2 SET SRA(0)=^SRA(SRAN,0)
SET DFN=$PIECE(SRA(0),"^")
SET (SDATE,X1)=$PIECE(SRA(0),"^",5)
SET X2=60
DO C^%DTC
SET SRUPPER=X
SET X2=-60
SET X1=SDATE
DO C^%DTC
SET SRLOWER=X
+3 DO DEM^VADPT
SET SRNAME=VADM(1)
KILL VADM
+4 SET SROPER=$PIECE(^SRA(SRAN,"OP"),"^")
KILL SROPS
IF $LENGTH(SROPER)<65
SET SROPS(1)=SROPER
IF $LENGTH(SROPER)>64
SET SROPER=SROPER_" "
KILL M,MM,MMM
FOR M=1:1
DO LOOP
IF MMM=""
QUIT
+5 WRITE @IOF,!,"PATIENT: "_SRNAME,?50,"DATE OF OPERATION: "_$EXTRACT(SDATE,4,5)_"/"_$EXTRACT(SDATE,6,7)_"/"_$EXTRACT(SDATE,2,3),!,"ASSESSMENT NUMBER: "_SRAN,!,"PROCEDURE: "_SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?12,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?12,SROPS(3)
+6 WRITE !
FOR LINE=1:1:80
WRITE "-"
+7 WRITE !
KILL SRCASE
SET (SRTN,CNT)=0
FOR
SET SRTN=$ORDER(^SRF("B",DFN,SRTN))
IF 'SRTN
QUIT
DO CHECK
IF CASE
SET SROP=SRTN
DO LIST
+8 IF '$DATA(SRCASE(1))
WRITE !!,"There were no Surgery cases for "_SRNAME_" within the 60 days before",!,"or after the date of operation entered in this assessment."
DO DELETE
QUIT
+9 IF '$DATA(SRCASE(2))
DO ONLYONE
QUIT
+10 WRITE !!
FOR LINE=1:1:80
WRITE "-"
SEL WRITE !!,"Select the NUMBER corresponding to the ",!,"Surgery Case that this Assessment matches: "
READ X:DTIME
IF '$TEST!(X["^")
SET SRSOUT=1
QUIT
+1 IF X=""
DO DELETE
IF SRSOUT
SET SRSOUT=0
QUIT
+2 IF '$DATA(SRCASE(X))
WRITE !!,"Enter the number that corresponds to the Surgery case that this assessment ",!,"matches. If the assessment does not relate to any of the cases listed above,",!,"enter RETURN at the prompt."
GOTO SEL
MATCH WRITE !!,"Are you sure that this is the correct Surgery Case ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
QUIT
+1 SET SRYN=$EXTRACT(SRYN)
IF "YyNn"'[SRYN
WRITE !!,"Enter 'YES' to convert the assessemnt into the Surgery file, or 'NO' to make",!,"another selection."
GOTO MATCH
+2 IF "Yy"[SRYN
SET OK=1
SET SRTN=SRCASE(X)
WRITE !!,"Converting Risk Assessment Information..."
+3 QUIT
CHECK ; check for dates within 60 days of procedure
+1 SET CASE=0
SET SRSDATE=$PIECE(^SRF(SRTN,0),"^",9)
+2 IF SRSDATE<SRLOWER
QUIT
+3 IF SRSDATE>SRUPPER
QUIT
+4 SET CASE=1
+5 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 CNT=CNT+1
SET SRSDATE=$PIECE(^SRF(SROP,0),"^",9)
+7 WRITE !,CNT_". "
CASE WRITE $EXTRACT(SRSDATE,4,5)_"-"_$EXTRACT(SRSDATE,6,7)_"-"_$EXTRACT(SRSDATE,2,3)
+1 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
+2 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
+3 WRITE ?14,SROPS(1)
IF $DATA(SROPS(2))
WRITE !,?14,SROPS(2)
IF $DATA(SROPS(3))
WRITE !,?14,SROPS(3)
IF $DATA(SROPS(4))
WRITE !,?14,SROPS(4)
+4 WRITE !
SET SRCASE(CNT)=SROP
+5 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 procedures
+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
ONLYONE ; match if only one case
+1 WRITE !!,"Do you want to match the Risk Assessment with this Surgical Case ? NO// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
QUIT
+2 SET SRYN=$EXTRACT(SRYN)
IF "YyNn"'[SRYN
WRITE !!,"Enter 'YES' to move the Risk Assessment information into this surgical case,",!,"or 'NO' if the information does not relate to this surgical case."
GOTO ONLYONE
+3 IF "Nn"'[SRYN
SET SRTN=SRCASE(1)
SET OK=1
WRITE !!,"Converting Risk Assessment Information..."
QUIT
DELETE ; delete assessment
+1 WRITE !!,"Since this assessment cannot be matched to any Surgery case, it must be",!,"deleted.",!!,"Are you sure that you want to delete this assessment ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
QUIT
+2 SET SRYN=$EXTRACT(SRYN)
IF SRYN=""
SET SRYN="Y"
+3 IF "YyNn"'[SRYN
WRITE !!,"Enter 'YES' to delete this assessment from the SURGERY RISK ASSESSMENT",!,"file (139), or 'NO' to continue matching other assessments."
GOTO DELETE
+4 IF "Yy"'[SRYN
QUIT
+5 KILL DA,DIK
SET DA=SRAN
SET DIK="^SRA("
WRITE !!,"Deleting assessment from SURGERY RISK ASSESSMENT file (139)..."
DO ^DIK
+6 WRITE !!,"Press RETURN to continue "
READ X:DTIME
+7 QUIT
