SRODPT.m

SRODPT ;B'HAM ISC/MAM - SURGERY INFORMATION GENERATOR ; 18 FEB 91 3:00 PM

 ;;3.0; Surgery ;;24 Jun 93

DEM ; demographic information

 Q:'$D(SRFN)  S SR(0)=^SRF(SRFN,0),DFN=$P(SR(0),"^") D DEM^VADPT S SRFN(1)=VADM(1),SRFN(2)=$P(SR(0),"^",9),SRFN(3)=$P(SR(0),"^",10)

 S SRFN(4)=$S($D(^SRF(SRFN,33)):$P(^(33),"^"),1:"") I $D(^SRF(SRFN,34)) S SRFN(4)=SRFN(4)_"^"_$P(^(34),"^")

 S SRFN(5)=$P(SR(0),"^",3) I SRFN(5)'="" S SRFN(5)=$S(SRFN(5)="M":"MAJOR",1:"MINOR")

 S SRFN(6)=$P(SR(0),"^",4) I SRFN(6)'="" S SRFN(6)=$P(^SRO(137.45,SRFN(6),0),"^")

 S SRFN(7)=$S($D(^SRF(SRFN,1.1)):$P(^(1.1),"^",3),1:"") I SRFN(7)'="" S SRFN(7)=+SRFN(7)

 Q

CON ; concurrent case information

 Q:'$D(^SRF(SRFN,"CON"))  S SRFN("CON")=$P(^SRF(SRFN,"CON"),"^") S SRFN("CON")=SRFN("CON")_"^"_$P(^SRF(SRFN("CON"),"OP"),"^")_"^"_$P(^SRF(SRFN("CON"),"OP"),"^",2)

 Q

OPS ; operation information

 S SRFN("OP")=$P(^SRF(SRFN,"OP"),"^")_"^"_$P(^SRF(SRFN,"OP"),"^",2)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SRODPT   945     printed  Apr 09, 2024@21:41:01                                                                                                                                                                                                       Page 2

SRODPT    ;B'HAM ISC/MAM - SURGERY INFORMATION GENERATOR ; 18 FEB 91 3:00 PM

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

DEM       ; demographic information

 +1        if '$DATA(SRFN)

               QUIT 

           SET SR(0)=^SRF(SRFN,0)

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

           DO DEM^VADPT

           SET SRFN(1)=VADM(1)

           SET SRFN(2)=$PIECE(SR(0),"^",9)

           SET SRFN(3)=$PIECE(SR(0),"^",10)

 +2        SET SRFN(4)=$SELECT($DATA(^SRF(SRFN,33)):$PIECE(^(33),"^"),1:"")

           IF $DATA(^SRF(SRFN,34))

               SET SRFN(4)=SRFN(4)_"^"_$PIECE(^(34),"^")

 +3        SET SRFN(5)=$PIECE(SR(0),"^",3)

           IF SRFN(5)'=""

               SET SRFN(5)=$SELECT(SRFN(5)="M":"MAJOR",1:"MINOR")

 +4        SET SRFN(6)=$PIECE(SR(0),"^",4)

           IF SRFN(6)'=""

               SET SRFN(6)=$PIECE(^SRO(137.45,SRFN(6),0),"^")

 +5        SET SRFN(7)=$SELECT($DATA(^SRF(SRFN,1.1)):$PIECE(^(1.1),"^",3),1:"")

           IF SRFN(7)'=""

               SET SRFN(7)=+SRFN(7)

 +6        QUIT 

CON       ; concurrent case information

 +1        if '$DATA(^SRF(SRFN,"CON"))

               QUIT 

           SET SRFN("CON")=$PIECE(^SRF(SRFN,"CON"),"^")

           SET SRFN("CON")=SRFN("CON")_"^"_$PIECE(^SRF(SRFN("CON"),"OP"),"^")_"^"_$PIECE(^SRF(SRFN("CON"),"OP"),"^",2)

 +2        QUIT 

OPS       ; operation information

 +1        SET SRFN("OP")=$PIECE(^SRF(SRFN,"OP"),"^")_"^"_$PIECE(^SRF(SRFN,"OP"),"^",2)

 +2        QUIT