SROASWP3.m

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