86 lines
5.1 KiB
Mathematica
86 lines
5.1 KiB
Mathematica
SROCMP ;BIR/MAM - PERIOPERATIVE OCCURRENCES ;05/15/06
|
|
;;3.0; Surgery ;**22,26,29,38,50,143,153**;24 Jun 93;Build 11
|
|
BEG U IO S SRSOUT=0,PAGE=1 K ^TMP("SR",$J) S Y=DT X ^DD("DD") S SRPRINT="DATE PRINTED: "_Y,SRSDT=SRSD-.0001,SREDT=SRED+.9999
|
|
N SRFRTO S Y=SRSD X ^DD("DD") S SRFRTO="FROM: "_Y_" TO: ",Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_Y
|
|
F S SRSDT=$O(^SRF("AC",SRSDT)) Q:SRSDT>SREDT!('SRSDT)!(SRSOUT) S SRTN=0 F S SRTN=$O(^SRF("AC",SRSDT,SRTN)) Q:'SRTN!(SRSOUT) I $O(^SRF(SRTN,10,0))!$O(^SRF(SRTN,16,0)),$D(^SRF(SRTN,0)),$$MANDIV^SROUTL0(SRINSTP,SRTN) D UTIL
|
|
S (SRSS,SRHDR)=0 F S SRSS=$O(^TMP("SR",$J,SRSS)) Q:SRSS=""!(SRSOUT) D HDR^SROCMP2 S SRSDATE=0 F S SRSDATE=$O(^TMP("SR",$J,SRSS,SRSDATE)) Q:'SRSDATE!(SRSOUT) D MORE
|
|
G:SRSOUT END
|
|
I '$D(^TMP("SR",$J)) D HDR^SROCMP2 G:SRSOUT END W !!,"There are no perioperative occurrences recorded for the selected date range."
|
|
F I=$Y:1:IOSL-9 W !
|
|
S X="" D FOOT^SROCMP2
|
|
I SRBOTH S SRSOUT=0 D BEG^SROMORT S SRSOUT=1
|
|
END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP) S ZTREQ="@" Q
|
|
D ^%ZISC,^SRSKILL K SRTN W @IOF
|
|
Q
|
|
MORE S SRTN=0 F S SRTN=$O(^TMP("SR",$J,SRSS,SRSDATE,SRTN)) Q:'SRTN D SET
|
|
Q
|
|
ATT N SRDIV,SRY S SRY=$P($G(^SRF(SRTN,.1)),"^",13) I SRY D
|
|
.S Y=SRY,C=$P(^DD(130,.164,0),"^",2) D Y^DIQ S SRSS=Y
|
|
I SRY="" S SRDIV=$$SITE^SROUTL0(SRTN) I SRDIV,'$P(^SRO(133,SRDIV,0),"^",19) D
|
|
.S SRY=$P($G(^SRF(SRTN,.1)),"^",4) I SRY D
|
|
..S Y=SRY,C=$P(^DD(130,.14,0),"^",2) D Y^DIQ S SRSS=Y
|
|
S:'SRY SRY="ZZ" I SRSP,'$D(SRSP(SRY)) Q
|
|
S:'SRY SRSS="ATTENDING SURGEON NOT ENTERED"
|
|
S ^TMP("SR",$J,SRSS,SRSDT,SRTN)=""
|
|
Q
|
|
UTIL ; set ^TMP
|
|
I SRSEL=1 D Q
|
|
.S Y=$P(^SRF(SRTN,0),"^",4) S:'Y Y="ZZ" I SRSP,'$D(SRSP(Y)) Q
|
|
.S SRSS=$S(Y:$P(^SRO(137.45,Y,0),"^"),1:"SURGICAL SPECIALTY NOT ENTERED")
|
|
.S ^TMP("SR",$J,SRSS,SRSDT,SRTN)=""
|
|
I SRSEL=2 D ATT Q
|
|
I SRSEL=3 F SRI=10,16 S SROCC=0 F S SROCC=$O(^SRF(SRTN,SRI,SROCC)) Q:'SROCC S Y=$P(^SRF(SRTN,SRI,SROCC,0),"^",2) D:Y
|
|
.I SRSP,'$D(SRSP(Y)) Q
|
|
.S SRSS=$S(Y:$P(^SRO(136.5,Y,0),"^"),1:"OCCURRENCE CATEGORY NOT ENTERED")
|
|
.S ^TMP("SR",$J,SRSS,SRSDT,SRTN)=""
|
|
Q
|
|
SET ; set variables to print
|
|
K SRC S DFN=$P(^SRF(SRTN,0),"^") D DEM^VADPT S SRNM=VADM(1),SRSSN=VA("PID"),Y=$P(^SRF(SRTN,0),"^",9) D D^DIQ S SROD=$E(Y,1,18)
|
|
OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER="" D OTHER
|
|
K SRP,Z S:$L(SROPER)<50 SRP(1)=SROPER I $L(SROPER)>49 S SROPER=SROPER_" " F M=1:1 D OPER Q:Z=""
|
|
S SRATT="",Y=$P($G(^SRF(SRTN,.1)),"^",13) I Y S C=$P(^DD(130,.164,0),"^",2) D Y^DIQ S SRATT=Y
|
|
I SRATT="" S SRDIV=$$SITE^SROUTL0(SRTN) I SRDIV,'$P(^SRO(133,SRDIV,0),"^",19) D
|
|
.S Y=$P($G(^SRF(SRTN,.1)),"^",4),C=$P(^DD(130,.14,0),"^",2) D Y^DIQ S SRATT=Y
|
|
I SRATT="" S SRATT="ATTENDING SURGEON NOT ENTERED"
|
|
S Y=$P(^SRF(SRTN,0),"^",4),SRSPEC=$S(Y:$P(^SRO(137.45,Y,0),"^"),1:"SURGICAL SPECIALTY NOT ENTERED")
|
|
COMP ; perioperative occurrences
|
|
S (SRFG,SRIC,SRPC)=0 F S SRIC=$O(^SRF(SRTN,10,SRIC)) Q:SRIC="" S SRFG=SRFG+1,SRC(SRFG)=$P(^(SRIC,0),"^")_"^"_$P(^(0),"^",6)_"^^"_$S($D(^SRF(SRTN,10,SRIC,2)):$P(^(2),"^"),1:"")_"^10^"_SRIC
|
|
S SRPC=0 F S SRPC=$O(^SRF(SRTN,16,SRPC)) Q:SRPC="" D
|
|
.S SRFG=SRFG+1,SRC(SRFG)=$P(^SRF(SRTN,16,SRPC,0),"^")_" *^"_$P(^(0),"^",6)_"^"_$P(^(0),"^",7)_"^"_$S($D(^SRF(SRTN,16,SRPC,2)):$P(^(2),"^"),1:"")_"^16^"_SRPC
|
|
.I $P(^SRF(SRTN,16,SRPC,0),"^",2)=3 S SRC(SRFG)=SRC(SRFG)_"^"_$P(^SRF(SRTN,16,SRPC,0),"^",4)
|
|
PRINT ; print perioperative occurrence information
|
|
I $Y+10>IOSL D HDR^SROCMP2 I SRSOUT Q
|
|
S SRHDR=1 W !!,SRNM,?29,$S(SRSEL=2:SRSPEC,1:SRATT) S SRC=$O(SRC(0)) W ?80,$P(SRC(SRC),"^") D DATE W ?129,$P(SRC(SRC),"^",2)
|
|
I SRSEL=3 D PRNT3 Q
|
|
W !,VA("PID"),?29,SRP(1),?80,$P(SRC(SRC),"^",4)
|
|
W !,SROD W:$D(SRP(2)) ?29,SRP(2) D TEXT W:$D(SRP(3))!SRT ! W:$D(SRP(3)) ?29,SRP(3) D:SRT WP
|
|
SRC I SRC F S SRC=$O(SRC(SRC)) Q:'SRC!SRSOUT D
|
|
.I $Y+10>IOSL D HDR^SROCMP2 I SRSOUT Q
|
|
.W !,?80,$P(SRC(SRC),"^") D DATE W ?129,$P(SRC(SRC),"^",2),!,?80,$P(SRC(SRC),"^",4),! D TEXT I SRT W ! D WP
|
|
Q
|
|
PRNT3 W !,VA("PID"),?29,SRSPEC,?80,$P(SRC(SRC),"^",4)
|
|
W !,SROD W ?29,SRP(1) D TEXT W:$D(SRP(2))!SRT ! W:$D(SRP(2)) ?29,SRP(2) D:SRT WP
|
|
D SRC
|
|
Q
|
|
WP ; print perioperative occurrence comments
|
|
K ^UTILITY($J,"W") S CM=0 F S CM=$O(^SRF(SRTN,SRX,SRY,1,CM)) Q:'CM S X=^SRF(SRTN,SRX,SRY,1,CM,0),DIWL=81,DIWR=132 D ^DIWP
|
|
I $D(^UTILITY($J,"W")) F J=1:1:^UTILITY($J,"W",81) D
|
|
.I $Y+7>IOSL D HDR^SROCMP2 W ! I SRSOUT Q
|
|
.W ?81,^UTILITY($J,"W",81,J,0),!
|
|
Q
|
|
TEXT ; check for comments
|
|
S SRT=0,SRX=$P(SRC(SRC),"^",5),SRY=$P(SRC(SRC),"^",6) I $O(^SRF(SRTN,SRX,SRY,1,0)) S SRT=1 I SRT W ?80,">>> Comments:"
|
|
Q
|
|
OTHER ; other operations
|
|
S SRLONG=1 I $L(SROPER)+$L($P(^SRF(SRTN,13,OPER,0),"^"))>250 S SRLONG=0,OPER=999,SROPERS=" ..."
|
|
I SRLONG S SROPERS=$P(^SRF(SRTN,13,OPER,0),"^")
|
|
S SROPER=SROPER_$S(SROPERS=" ...":SROPERS,1:", "_SROPERS)
|
|
Q
|
|
OPER ; break procedure if greater than 50 characters
|
|
S SRP(M)="" F LOOP=1:1 S Z=$P(SROPER," ") Q:Z="" Q:$L(SRP(M))+$L(Z)'<50 S SRP(M)=SRP(M)_Z_" ",SROPER=$P(SROPER," ",2,200)
|
|
Q
|
|
DATE N SRSEP
|
|
S X=$P(SRC(SRC),"^",7) I X S SRSEP=$S(X=2:"SEPSIS",X=3:"SEPTIC SHOCK",1:"SIRS") W " /"_SRSEP
|
|
I $P(SRC(SRC),"^",3)'="" S SRDT=$P(SRC(SRC),"^",3) I SRDT W " ("_$E(SRDT,4,5)_"/"_$E(SRDT,6,7)_"/"_$E(SRDT,2,3)_")"
|
|
Q
|