SROAL21.m

SROAL21 ;BIR/ADM - LOAD POSTOPERATIVE LAB DATA (CONTINUED) ;06/27/06

 ;;3.0; Surgery ;**38,47,65,88,125,153**;24 Jun 93;Build 11

STUFF ; Transfer data from arrays to file 130.

 W !!,"..Moving postoperative lab data to Surgery Risk Assessment file...."

SRAT2 I $D(SRAT("H",2)) S X=SRAT("H",2) S SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,203),"^",13)=X,$P(^(204),"^",13)=$S(X'="":SRAD("H",2),1:"")

SRAT3 I $D(SRAT("H",3)) S X=SRAT("H",3) S SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,203),"^",14)=X,$P(^(204),"^",14)=$S(X'="":SRAD("H",3),1:"")

SRAT4 I $D(SRAT("H",4)) S X=SRAT("H",4) S SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,203),"^")=X,$P(^(204),"^")=$S(X'="":SRAD("H",4),1:"")

SRAT5 I $D(SRAT("H",5)) S X=SRAT("H",5) S SRL=1,SRH=3 D INPUT S $P(^SRF(SRTN,203),"^",3)=X,$P(^(204),"^",3)=$S(X'="":SRAD("H",5),1:"")

SRAT7 I $D(SRAT("H",7)) S X=SRAT("H",7) S SRL=1,SRH=4 D INPUT S $P(^SRF(SRTN,203),"^",6)=X,$P(^(204),"^",6)=$S(X'="":SRAD("H",7),1:"")

SRAT9 I $D(SRAT("H",9)) S X=SRAT("H",9) S SRL=1,SRH=6 D INPUT S $P(^SRF(SRTN,203),"^",7)=X,$P(^(204),"^",7)=$S(X'="":SRAD("H",9),1:"")

SRAT10 I $D(SRAT("H",10)) S X=SRAT("H",10) S SRL=1,SRH=4 D INPUT S $P(^SRF(SRTN,203),"^",8)=X,$P(^(204),"^",8)=$S(X'="":SRAD("H",10),1:"")

SRAT14 I $D(SRAT("H",14)) S X=SRAT("H",14) S SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,203),"^",9)=X,$P(^(204),"^",9)=$S(X'="":SRAD("H",14),1:"")

SRAT16 I $D(SRAT("H",16)) S X=SRAT("H",16) S SRL=1,SRH=4 D INPUT S $P(^SRF(SRTN,203),"^",10)=X,$P(^(204),"^",10)=$S(X'="":SRAD("H",16),1:"")

SRAT17 I $D(SRAT("L",17)) S X=SRAT("L",17) S SRL=1,SRH=4 D INPUT S $P(^SRF(SRTN,203),"^",12)=X,$P(^(204),"^",12)=$S(X'="":SRAD("L",17),1:"")

SRAT26 I $D(SRAT("H",26)) S X=SRAT("H",26) S SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,203),"^",16)=X,$P(^(204),"^",16)=$S(X'="":SRAD("H",26),1:"")

SRAT4L I $D(SRAT("L",4)) S X=SRAT("L",4) S SRL=1,SRH=5 D INPUT S $P(^SRF(SRTN,203),"^",2)=X,$P(^(204),"^",2)=$S(X'="":SRAD("L",4),1:"")

SRAT5L I $D(SRAT("L",5)) S X=SRAT("L",5) S SRL=1,SRH=3 D INPUT S $P(^SRF(SRTN,203),"^",4)=X,$P(^(204),"^",4)=$S(X'="":SRAD("L",5),1:"")

 Q

NUM ; input transform logic for lab tests  

 N SRX I X="NS"!(X="ns") S X="NS" D:$D(SRCICSP) CARDNS Q

 S SRX=X S:"<>"[$E(X) SRX=$E(X,2,99)

 I +SRX'=SRX K X Q

 Q

INPUT ; capture input check

 N SRX,SRY I X="NS"!(X="") Q

 I $L(X)<SRL S X="" Q

 S SRX=X,SRY="" S:" <>"[$E(X) SRY=$E(X),SRX=$E(X,2,99)

 I +SRX'=SRX S X=""

 I $L(X)>SRH D

 .I SRX["." S SRX=SRX+.05\.1*.1,X=SRY_SRX I $L(X)>SRH S SRX=SRX+.5\1,X=SRY_SRX

 .I $L(X)>SRH S X=""

 Q

CARDNS ; if cardiac, NS not allowed

 N SRTYPE,SRXX

 S SRXX=$S($D(SRTN):SRTN,$D(DA):DA,1:"") Q:'SRXX

 S SRTYPE=$P($G(^SRF(SRXX,"RA")),"^",2)

 I SRTYPE="C" K X

 K SRCICSP

 Q

SROAL21   ;BIR/ADM - LOAD POSTOPERATIVE LAB DATA (CONTINUED) ;06/27/06

 +1       ;;3.0; Surgery ;**38,47,65,88,125,153**;24 Jun 93;Build 11

STUFF     ; Transfer data from arrays to file 130.

 +1        WRITE !!,"..Moving postoperative lab data to Surgery Risk Assessment file...."

SRAT2      IF $DATA(SRAT("H",2))

               SET X=SRAT("H",2)

               SET SRL=1

               SET SRH=5

               DO INPUT

               SET $PIECE(^SRF(SRTN,203),"^",13)=X

               SET $PIECE(^(204),"^",13)=$SELECT(X'="":SRAD("H",2),1:"")

SRAT3      IF $DATA(SRAT("H",3))

               SET X=SRAT("H",3)

               SET SRL=1

               SET SRH=5

               DO INPUT

               SET $PIECE(^SRF(SRTN,203),"^",14)=X

               SET $PIECE(^(204),"^",14)=$SELECT(X'="":SRAD("H",3),1:"")

SRAT4      IF $DATA(SRAT("H",4))

               SET X=SRAT("H",4)

               SET SRL=1

               SET SRH=5

               DO INPUT

               SET $PIECE(^SRF(SRTN,203),"^")=X

               SET $PIECE(^(204),"^")=$SELECT(X'="":SRAD("H",4),1:"")

SRAT5      IF $DATA(SRAT("H",5))

               SET X=SRAT("H",5)

               SET SRL=1

               SET SRH=3

               DO INPUT

               SET $PIECE(^SRF(SRTN,203),"^",3)=X

               SET $PIECE(^(204),"^",3)=$SELECT(X'="":SRAD("H",5),1:"")

SRAT7      IF $DATA(SRAT("H",7))

               SET X=SRAT("H",7)

               SET SRL=1

               SET SRH=4

               DO INPUT

               SET $PIECE(^SRF(SRTN,203),"^",6)=X

               SET $PIECE(^(204),"^",6)=$SELECT(X'="":SRAD("H",7),1:"")

SRAT9      IF $DATA(SRAT("H",9))

               SET X=SRAT("H",9)

               SET SRL=1

               SET SRH=6

               DO INPUT

               SET $PIECE(^SRF(SRTN,203),"^",7)=X

               SET $PIECE(^(204),"^",7)=$SELECT(X'="":SRAD("H",9),1:"")

SRAT10     IF $DATA(SRAT("H",10))

               SET X=SRAT("H",10)

               SET SRL=1

               SET SRH=4

               DO INPUT

               SET $PIECE(^SRF(SRTN,203),"^",8)=X

               SET $PIECE(^(204),"^",8)=$SELECT(X'="":SRAD("H",10),1:"")

SRAT14     IF $DATA(SRAT("H",14))

               SET X=SRAT("H",14)

               SET SRL=1

               SET SRH=5

               DO INPUT

               SET $PIECE(^SRF(SRTN,203),"^",9)=X

               SET $PIECE(^(204),"^",9)=$SELECT(X'="":SRAD("H",14),1:"")

SRAT16     IF $DATA(SRAT("H",16))

               SET X=SRAT("H",16)

               SET SRL=1

               SET SRH=4

               DO INPUT

               SET $PIECE(^SRF(SRTN,203),"^",10)=X

               SET $PIECE(^(204),"^",10)=$SELECT(X'="":SRAD("H",16),1:"")

SRAT17     IF $DATA(SRAT("L",17))

               SET X=SRAT("L",17)

               SET SRL=1

               SET SRH=4

               DO INPUT

               SET $PIECE(^SRF(SRTN,203),"^",12)=X

               SET $PIECE(^(204),"^",12)=$SELECT(X'="":SRAD("L",17),1:"")

SRAT26     IF $DATA(SRAT("H",26))

               SET X=SRAT("H",26)

               SET SRL=1

               SET SRH=5

               DO INPUT

               SET $PIECE(^SRF(SRTN,203),"^",16)=X

               SET $PIECE(^(204),"^",16)=$SELECT(X'="":SRAD("H",26),1:"")

SRAT4L     IF $DATA(SRAT("L",4))

               SET X=SRAT("L",4)

               SET SRL=1

               SET SRH=5

               DO INPUT

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

               SET $PIECE(^(204),"^",2)=$SELECT(X'="":SRAD("L",4),1:"")

SRAT5L     IF $DATA(SRAT("L",5))

               SET X=SRAT("L",5)

               SET SRL=1

               SET SRH=3

               DO INPUT

               SET $PIECE(^SRF(SRTN,203),"^",4)=X

               SET $PIECE(^(204),"^",4)=$SELECT(X'="":SRAD("L",5),1:"")

 +1        QUIT 

NUM       ; input transform logic for lab tests  

 +1        NEW SRX

           IF X="NS"!(X="ns")

               SET X="NS"

               IF $DATA(SRCICSP)

                   DO CARDNS

               QUIT 

 +2        SET SRX=X

           IF "<>"[$EXTRACT(X)

               SET SRX=$EXTRACT(X,2,99)

 +3        IF +SRX'=SRX

               KILL X

               QUIT 

 +4        QUIT 

INPUT     ; capture input check

 +1        NEW SRX,SRY

           IF X="NS"!(X="")

               QUIT 

 +2        IF $LENGTH(X)<SRL

               SET X=""

               QUIT 

 +3        SET SRX=X

           SET SRY=""

           IF " <>"[$EXTRACT(X)

               SET SRY=$EXTRACT(X)

               SET SRX=$EXTRACT(X,2,99)

 +4        IF +SRX'=SRX

               SET X=""

 +5        IF $LENGTH(X)>SRH

               Begin DoDot:1

 +6                IF SRX["."

                       SET SRX=SRX+.05\.1*.1

                       SET X=SRY_SRX

                       IF $LENGTH(X)>SRH

                           SET SRX=SRX+.5\1

                           SET X=SRY_SRX

 +7                IF $LENGTH(X)>SRH

                       SET X=""

               End DoDot:1

 +8        QUIT 

CARDNS    ; if cardiac, NS not allowed

 +1        NEW SRTYPE,SRXX

 +2        SET SRXX=$SELECT($DATA(SRTN):SRTN,$DATA(DA):DA,1:"")

           IF 'SRXX

               QUIT 

 +3        SET SRTYPE=$PIECE($GET(^SRF(SRXX,"RA")),"^",2)

 +4        IF SRTYPE="C"

               KILL X

 +5        KILL SRCICSP

 +6        QUIT