SROCOMP.m

SROCOMP ;BIR/MAM - VIEW OCCURRENCES ; [ 05/11/04  7:54 AM ]

 ;;3.0; Surgery ;**37,38,88,129**;24 Jun 93

 S SRSOUT=0 K SRNEWOP D ^SROPS I '$D(SRTN) S SRSOUT=1 G END

 S SR(0)=^SRF(SRTN,0),DFN=$P(SR(0),"^") D DEM^VADPT S SRNAME=VADM(1)_" ("_VA("PID")_")"

 S Y=$P(SR(0),"^",9) D D^DIQ S SRSDATE=$P(Y,"@")_" "_$P(Y,"@",2)

 S SR(.1)=$G(^SRF(SRTN,.1)),SRSUR=$P(SR(.1),"^",4),SRATT=$P(SR(.1),"^",13)

 S SRSUR=$S(SRSUR:$P(^VA(200,SRSUR,0),"^"),1:"NOT ENTERED"),SRATT=$S(SRATT:$P(^VA(200,SRATT,0),"^"),1:"NOT ENTERED")

 S SRATC="",Y=$P($G(^SRF(SRTN,.1)),"^",10) I Y S C=$P(^DD(130,.166,0),"^",2) D Y^DIQ S SRATC=Y

 I SRATC="" S SRATC="ATTENDING CODE NOT ENTERED"

 S SROPER=$P(^SRF(SRTN,"OP"),"^"),X=$P(^("OP"),"^",2) I X S CPT=$P($$CPT^ICPTCOD(X),"^",2),Y=CPT D SSPRIN^SROCPT S CPT=Y,SROPER=SROPER_" ("_CPT_")"

 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 X=$P($G(^SRF(SRTN,.2)),"^",12) S DIAG=$S(X:"POST",1:"PRE")

 S SRDIAG=$S(DIAG="POST":$P($G(^SRF(SRTN,34)),"^"),1:$P($G(^SRF(SRTN,33)),"^")) I DIAG="POST" S X=$P($G(^SRF(SRTN,34)),"^",2) I X S ICD=$P(^ICD9(X,0),"^"),SRDIAG=SRDIAG_" ("_ICD_")"

 I '$L(SRDIAG) S SRDIAG="NOT ENTERED"

 S (CMP,CNT)=0 F  S CMP=$O(^SRF(SRTN,10,CMP)) Q:'CMP  S CNT=CNT+1,INTRA(CNT)=$P(^SRF(SRTN,10,CMP,0),"^")_"^"_$P(^(0),"^",6)

 S (CMP,CNT)=0 F  S CMP=$O(^SRF(SRTN,16,CMP)) Q:'CMP  S CNT=CNT+1,POST(CNT)=$P(^SRF(SRTN,16,CMP,0),"^")_"^"_$P(^(0),"^",6)_"^"_$P(^(0),"^",7)

 D HDR

 W !!,"Date of Operation: ",?21,SRSDATE,!,"Principal Operation: ",?21,SROPS(1) I $D(SROPS(2)) W !,?21,SROPS(2) I $D(SROPS(3)) W !,?21,SROPS(3)

 W !!,"Surgeon: ",?19,SRSUR,!,"Attending Surgeon: "_SRATT,!,"Attending Code: ",?16,SRATC

 W !!,"Principal "_$S(DIAG="POST":"Postop",1:"Preop")_" Diagnosis: ",?30,SRDIAG

 W !!,"Intraoperative Occurrences: " I '$O(INTRA(0)) W "NONE ENTERED"

 I $O(INTRA(0)) S CMP=0 F  S CMP=$O(INTRA(CMP)) Q:'CMP!(SRSOUT)  D INTRA

 G:SRSOUT END W !!,"Postoperative Occurrences:  " I '$O(POST(0)) W "NONE ENTERED"

 I $O(POST(0)) S CMP=0 F  S CMP=$O(POST(CMP)) Q:'CMP!(SRSOUT)  D POST

 I SRSOUT G END

 K SRRET S (RET,CNT)=0 F  S RET=$O(^SRF(SRTN,29,RET)) Q:'RET  S X=^SRF(SRTN,29,RET,0),Y=$P(X,"^",3) I Y="R" S CNT=CNT+1,SRRET(CNT)=$P(X,"^")

 I $O(SRRET(0)) D RET W !!,"Related Returns to Surgery: " S RET=0 F  S RET=$O(SRRET(RET)) Q:'RET!(SRSOUT)  D RELATE

END I 'SRSOUT W !!,"Press RETURN to continue  " R X:DTIME

 D ^SRSKILL K SRTN W @IOF

 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

RET W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q

 I X["?" W !!,"Press RETURN to list more information, or '^' to leave this option." G RET

HDR W @IOF,!,SRNAME,?50,"OCCURRENCES",! F LINE=1:1:80 W "-"

 Q

INTRA ; intraop occurrences

 I $Y+4>IOSL D RET I SRSOUT Q

 W:CMP>1 ! W ?30,$P(INTRA(CMP),"^") S OUT=$P(INTRA(CMP),"^",2),OUT=$S(OUT="I":"IMPROVED",OUT="W":"WORSE",OUT="D":"DEATH",OUT="U":"UNRESOLVED",1:"NOT ENTERED") W !,?30,"Outcome: "_OUT

 Q

POST ; postop occurrences

 I $Y+4>IOSL D RET I SRSOUT Q

 W:CMP>1 ! W ?30,$P(POST(CMP),"^") S D=$P(POST(CMP),"^",3) I D S D=" ("_$E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)_")" W D

 S OUT=$P(POST(CMP),"^",2),OUT=$S(OUT="I":"IMPROVED",OUT="W":"WORSE",OUT="D":"DEATH",OUT="U":"UNRESOLVED",1:"NOT ENTERED") W !,?30,"Outcome: "_OUT

 Q

RELATE ; print related returns

 I $Y+4>IOSL D RET I SRSOUT Q

 S Y=$P(^SRF(SRRET(RET),0),"^",9),SRSDATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),SROPER=$P(^SRF(SRRET(RET),"OP"),"^")

 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=""

 W !,SRSDATE,?10,SROPS(1) I $D(SROPS(2)) W !,?10,SROPS(2) I $D(SROPS(3)) W !,?10,SROPS(3)

 W !

 Q

SROCOMP   ;BIR/MAM - VIEW OCCURRENCES ; [ 05/11/04  7:54 AM ]

 +1       ;;3.0; Surgery ;**37,38,88,129**;24 Jun 93

 +2        SET SRSOUT=0

           KILL SRNEWOP

           DO ^SROPS

           IF '$DATA(SRTN)

               SET SRSOUT=1

               GOTO END

 +3        SET SR(0)=^SRF(SRTN,0)

           SET DFN=$PIECE(SR(0),"^")

           DO DEM^VADPT

           SET SRNAME=VADM(1)_" ("_VA("PID")_")"

 +4        SET Y=$PIECE(SR(0),"^",9)

           DO D^DIQ

           SET SRSDATE=$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)

 +5        SET SR(.1)=$GET(^SRF(SRTN,.1))

           SET SRSUR=$PIECE(SR(.1),"^",4)

           SET SRATT=$PIECE(SR(.1),"^",13)

 +6        SET SRSUR=$SELECT(SRSUR:$PIECE(^VA(200,SRSUR,0),"^"),1:"NOT ENTERED")

           SET SRATT=$SELECT(SRATT:$PIECE(^VA(200,SRATT,0),"^"),1:"NOT ENTERED")

 +7        SET SRATC=""

           SET Y=$PIECE($GET(^SRF(SRTN,.1)),"^",10)

           IF Y

               SET C=$PIECE(^DD(130,.166,0),"^",2)

               DO Y^DIQ

               SET SRATC=Y

 +8        IF SRATC=""

               SET SRATC="ATTENDING CODE NOT ENTERED"

 +9        SET SROPER=$PIECE(^SRF(SRTN,"OP"),"^")

           SET X=$PIECE(^("OP"),"^",2)

           IF X

               SET CPT=$PIECE($$CPT^ICPTCOD(X),"^",2)

               SET Y=CPT

               DO SSPRIN^SROCPT

               SET CPT=Y

               SET SROPER=SROPER_" ("_CPT_")"

 +10       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 

 +11       SET X=$PIECE($GET(^SRF(SRTN,.2)),"^",12)

           SET DIAG=$SELECT(X:"POST",1:"PRE")

 +12       SET SRDIAG=$SELECT(DIAG="POST":$PIECE($GET(^SRF(SRTN,34)),"^"),1:$PIECE($GET(^SRF(SRTN,33)),"^"))

           IF DIAG="POST"

               SET X=$PIECE($GET(^SRF(SRTN,34)),"^",2)

               IF X

                   SET ICD=$PIECE(^ICD9(X,0),"^")

                   SET SRDIAG=SRDIAG_" ("_ICD_")"

 +13       IF '$LENGTH(SRDIAG)

               SET SRDIAG="NOT ENTERED"

 +14       SET (CMP,CNT)=0

           FOR 

               SET CMP=$ORDER(^SRF(SRTN,10,CMP))

               IF 'CMP

                   QUIT 

               SET CNT=CNT+1

               SET INTRA(CNT)=$PIECE(^SRF(SRTN,10,CMP,0),"^")_"^"_$PIECE(^(0),"^",6)

 +15       SET (CMP,CNT)=0

           FOR 

               SET CMP=$ORDER(^SRF(SRTN,16,CMP))

               IF 'CMP

                   QUIT 

               SET CNT=CNT+1

               SET POST(CNT)=$PIECE(^SRF(SRTN,16,CMP,0),"^")_"^"_$PIECE(^(0),"^",6)_"^"_$PIECE(^(0),"^",7)

 +16       DO HDR

 +17       WRITE !!,"Date of Operation: ",?21,SRSDATE,!,"Principal Operation: ",?21,SROPS(1)

           IF $DATA(SROPS(2))

               WRITE !,?21,SROPS(2)

               IF $DATA(SROPS(3))

                   WRITE !,?21,SROPS(3)

 +18       WRITE !!,"Surgeon: ",?19,SRSUR,!,"Attending Surgeon: "_SRATT,!,"Attending Code: ",?16,SRATC

 +19       WRITE !!,"Principal "_$SELECT(DIAG="POST":"Postop",1:"Preop")_" Diagnosis: ",?30,SRDIAG

 +20       WRITE !!,"Intraoperative Occurrences: "

           IF '$ORDER(INTRA(0))

               WRITE "NONE ENTERED"

 +21       IF $ORDER(INTRA(0))

               SET CMP=0

               FOR 

                   SET CMP=$ORDER(INTRA(CMP))

                   IF 'CMP!(SRSOUT)

                       QUIT 

                   DO INTRA

 +22       IF SRSOUT

               GOTO END

           WRITE !!,"Postoperative Occurrences:  "

           IF '$ORDER(POST(0))

               WRITE "NONE ENTERED"

 +23       IF $ORDER(POST(0))

               SET CMP=0

               FOR 

                   SET CMP=$ORDER(POST(CMP))

                   IF 'CMP!(SRSOUT)

                       QUIT 

                   DO POST

 +24       IF SRSOUT

               GOTO END

 +25       KILL SRRET

           SET (RET,CNT)=0

           FOR 

               SET RET=$ORDER(^SRF(SRTN,29,RET))

               IF 'RET

                   QUIT 

               SET X=^SRF(SRTN,29,RET,0)

               SET Y=$PIECE(X,"^",3)

               IF Y="R"

                   SET CNT=CNT+1

                   SET SRRET(CNT)=$PIECE(X,"^")

 +26       IF $ORDER(SRRET(0))

               DO RET

               WRITE !!,"Related Returns to Surgery: "

               SET RET=0

               FOR 

                   SET RET=$ORDER(SRRET(RET))

                   IF 'RET!(SRSOUT)

                       QUIT 

                   DO RELATE

END        IF 'SRSOUT

               WRITE !!,"Press RETURN to continue  "

               READ X:DTIME

 +1        DO ^SRSKILL

           KILL SRTN

           WRITE @IOF

 +2        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 

RET        WRITE !!,"Press RETURN to continue, or '^' to quit: "

           READ X:DTIME

           IF '$TEST!(X["^")

               SET SRSOUT=1

               QUIT 

 +1        IF X["?"

               WRITE !!,"Press RETURN to list more information, or '^' to leave this option."

               GOTO RET

HDR        WRITE @IOF,!,SRNAME,?50,"OCCURRENCES",!

           FOR LINE=1:1:80

               WRITE "-"

 +1        QUIT 

INTRA     ; intraop occurrences

 +1        IF $Y+4>IOSL

               DO RET

               IF SRSOUT

                   QUIT 

 +2        IF CMP>1

               WRITE !

           WRITE ?30,$PIECE(INTRA(CMP),"^")

           SET OUT=$PIECE(INTRA(CMP),"^",2)

           SET OUT=$SELECT(OUT="I":"IMPROVED",OUT="W":"WORSE",OUT="D":"DEATH",OUT="U":"UNRESOLVED",1:"NOT ENTERED")

           WRITE !,?30,"Outcome: "_OUT

 +3        QUIT 

POST      ; postop occurrences

 +1        IF $Y+4>IOSL

               DO RET

               IF SRSOUT

                   QUIT 

 +2        IF CMP>1

               WRITE !

           WRITE ?30,$PIECE(POST(CMP),"^")

           SET D=$PIECE(POST(CMP),"^",3)

           IF D

               SET D=" ("_$EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)_")"

               WRITE D

 +3        SET OUT=$PIECE(POST(CMP),"^",2)

           SET OUT=$SELECT(OUT="I":"IMPROVED",OUT="W":"WORSE",OUT="D":"DEATH",OUT="U":"UNRESOLVED",1:"NOT ENTERED")

           WRITE !,?30,"Outcome: "_OUT

 +4        QUIT 

RELATE    ; print related returns

 +1        IF $Y+4>IOSL

               DO RET

               IF SRSOUT

                   QUIT 

 +2        SET Y=$PIECE(^SRF(SRRET(RET),0),"^",9)

           SET SRSDATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)

           SET SROPER=$PIECE(^SRF(SRRET(RET),"OP"),"^")

 +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        WRITE !,SRSDATE,?10,SROPS(1)

           IF $DATA(SROPS(2))

               WRITE !,?10,SROPS(2)

               IF $DATA(SROPS(3))

                   WRITE !,?10,SROPS(3)

 +5        WRITE !

 +6        QUIT