SROASSN.m

SROASSN ;B'HAM ISC/MAM - SELECT ASSESSMENT ; [ 07/03/03 08:44 AM ]

 ;;3.0; Surgery ;**121**;24 Jun 93

 ;

 W !! S (SRDT,CNT)=0 F I=0:0 S SRDT=$O(^SRF("ADT",DFN,SRDT)) Q:'SRDT!(SRSOUT)  S SRASS=0 F I=0:0 S SRASS=$O(^SRF("ADT",DFN,SRDT,SRASS)) Q:'SRASS!($D(SRTN))!(SRSOUT)  I SRASS=SROP D LIST

 I '$D(SRCASE(1)) D  Q

 .W @IOF,!,?1,SRANM

 .W !!,$E(SRSDATE,4,5)_"-"_$E(SRSDATE,6,7)_"-"_$E(SRSDATE,2,3),?14,SROPER_" ("_STATUS_")"

 .W !!,$S($P($G(^SRF(SROP,"NON")),"^")="Y":"Case #"_SROP_" is not an O.R. surgical procedure.",1:"There is no Surgery Risk Assessment entered for Case #"_SROP_".")

 .W !!,"Press <RET> to continue.",! R X:DTIME S:'$T SRSOUT=1 S SRBACK=1

 S SRTN=+SRCASE(1)

 Q

LIST ; list assessments

 S CNT=CNT+1,SRSDATE=$P(^SRF(SRASS,0),"^",9)

DISP S SROPER=$P(^SRF(SRASS,"OP"),"^") I $O(^SRF(SRASS,13,0)) S SROTHER=0 F I=0:0 S SROTHER=$O(^SRF(SRASS,13,SROTHER)) Q:'SROTHER  D OTHER

 S SR("RA")=$G(^SRF(SRASS,"RA")),Z=$P(SR("RA"),"^"),STATUS=$S(Z="I":"INCOMPLETE",Z="C":"COMPLETED",Z="T":"TRANSMITTED",1:"INCOMPLETE")

 I "N"[$P(SR("RA"),"^",2),"N"[$P(SR("RA"),"^",6) S CNT=CNT-1 Q

 I $P(SR("RA"),"^",2)="C" S SROPER="* "_SROPER

 S SROPER=SROPER_" ("_STATUS_")"

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

 ;I '$D(SRTN) W CNT_". "

CASE ;W $E(SRSDATE,4,5)_"-"_$E(SRSDATE,6,7)_"-"_$E(SRSDATE,2,3),?14,SROPS(1) I $D(SROPS(2)) W !,?14,SROPS(2) I $D(SROPS(3)) W !,?14,SROPS(3)

 ;I $D(SROPS(4)) W !,?14,SROPS(4)

 I $D(SRTN) Q

 W !! S SRCASE(CNT)=SRASS_"^"_SRDT

 Q

OTHER ; other operations

 S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRASS,13,SROTHER,0),"^"))>235 S SRLONG=0,SROTHER=999,SROPERS=" ..."

 I SRLONG S SROPERS=$P(^SRF(SRASS,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

SROASSN   ;B'HAM ISC/MAM - SELECT ASSESSMENT ; [ 07/03/03 08:44 AM ]

 +1       ;;3.0; Surgery ;**121**;24 Jun 93

 +2       ;

 +3        WRITE !!

           SET (SRDT,CNT)=0

           FOR I=0:0

               SET SRDT=$ORDER(^SRF("ADT",DFN,SRDT))

               IF 'SRDT!(SRSOUT)

                   QUIT 

               SET SRASS=0

               FOR I=0:0

                   SET SRASS=$ORDER(^SRF("ADT",DFN,SRDT,SRASS))

                   IF 'SRASS!($DATA(SRTN))!(SRSOUT)

                       QUIT 

                   IF SRASS=SROP

                       DO LIST

 +4        IF '$DATA(SRCASE(1))

               Begin DoDot:1

 +5                WRITE @IOF,!,?1,SRANM

 +6                WRITE !!,$EXTRACT(SRSDATE,4,5)_"-"_$EXTRACT(SRSDATE,6,7)_"-"_$EXTRACT(SRSDATE,2,3),?14,SROPER_" ("_STATUS_")"

 +7                WRITE !!,$SELECT($PIECE($GET(^SRF(SROP,"NON")),"^")="Y":"Case #"_SROP_" is not an O.R. surgical procedure.",1:"There is no Surgery Risk Assessment entered for Case #"_SROP_".")

 +8                WRITE !!,"Press <RET> to continue.",!

                   READ X:DTIME

                   IF '$TEST

                       SET SRSOUT=1

                   SET SRBACK=1

               End DoDot:1

               QUIT 

 +9        SET SRTN=+SRCASE(1)

 +10       QUIT 

LIST      ; list assessments

 +1        SET CNT=CNT+1

           SET SRSDATE=$PIECE(^SRF(SRASS,0),"^",9)

DISP       SET SROPER=$PIECE(^SRF(SRASS,"OP"),"^")

           IF $ORDER(^SRF(SRASS,13,0))

               SET SROTHER=0

               FOR I=0:0

                   SET SROTHER=$ORDER(^SRF(SRASS,13,SROTHER))

                   IF 'SROTHER

                       QUIT 

                   DO OTHER

 +1        SET SR("RA")=$GET(^SRF(SRASS,"RA"))

           SET Z=$PIECE(SR("RA"),"^")

           SET STATUS=$SELECT(Z="I":"INCOMPLETE",Z="C":"COMPLETED",Z="T":"TRANSMITTED",1:"INCOMPLETE")

 +2        IF "N"[$PIECE(SR("RA"),"^",2)

               IF "N"[$PIECE(SR("RA"),"^",6)

                   SET CNT=CNT-1

                   QUIT 

 +3        IF $PIECE(SR("RA"),"^",2)="C"

               SET SROPER="* "_SROPER

 +4        SET SROPER=SROPER_" ("_STATUS_")"

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

 +6       ;I '$D(SRTN) W CNT_". "

CASE      ;W $E(SRSDATE,4,5)_"-"_$E(SRSDATE,6,7)_"-"_$E(SRSDATE,2,3),?14,SROPS(1) I $D(SROPS(2)) W !,?14,SROPS(2) I $D(SROPS(3)) W !,?14,SROPS(3)

 +1       ;I $D(SROPS(4)) W !,?14,SROPS(4)

 +2        IF $DATA(SRTN)

               QUIT 

 +3        WRITE !!

           SET SRCASE(CNT)=SRASS_"^"_SRDT

 +4        QUIT 

OTHER     ; other operations

 +1        SET SRLONG=1

           IF $LENGTH(SROPER)+$LENGTH($PIECE(^SRF(SRASS,13,SROTHER,0),"^"))>235

               SET SRLONG=0

               SET SROTHER=999

               SET SROPERS=" ..."

 +2        IF SRLONG

               SET SROPERS=$PIECE(^SRF(SRASS,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