52 lines
3.4 KiB
Mathematica
52 lines
3.4 KiB
Mathematica
SROANP ;B'HAM ISC/MAM - LIST OF ANESTHETIC PROCEDURES ; [ 09/07/00 11:27 AM ]
|
|
;;3.0; Surgery ;**38,53,50,95,151**;24 Jun 93
|
|
;
|
|
;Reference to ^PSS50 supported by DBIA #4533
|
|
;
|
|
SET ; set and print information for a case
|
|
S SRNON=0 I $P($G(^SRF(SRTN,"NON")),"^")="Y" S SRNON=1
|
|
I SRFLG=1!(SRFLG=3&('SRNON)) Q:$P($G(^SRF(SRTN,.2)),"^",12)=""
|
|
I SRFLG=2 Q:'SRNON
|
|
K S(.2),SRAGNT,SRTECH,SRPRIN,SRANE3
|
|
S S(0)=^SRF(SRTN,0),DFN=+S(0) D DEM^VADPT S SRDPT=VADM(1),SRSSN=VA("PID"),SRDATE=$P(S(0),"^",9),Y=SRDATE,SRDT=$E(SRDATE,4,5)_"/"_$E(SRDATE,6,7)_"/"_$E(SRDATE,2,3)
|
|
D D^DIQ S SRFIND=$F(Y,":") S SRDATE=$S(SRFIND:SRDT_" "_$E(Y,SRFIND-3,SRFIND+1),1:SRDT)
|
|
S:SRDPT>18 SRDPT=$P(SRDPT,",")_", "_$E($P(SRDPT,",",2))
|
|
I 'SRNON S SRICD=$S($D(^SRF(SRTN,34)):$P(^(34),"^"),$D(^SRF(SRTN,33)):$P(^(33),"^"),1:"")
|
|
I SRNON S SRICD=$P($G(^SRF(SRTN,33)),"^",2)
|
|
OPS S SROPER=$P(^SRF(SRTN,"OP"),"^"),OPER=0 F S OPER=$O(^SRF(SRTN,13,OPER)) Q:OPER="" D OTHER
|
|
K SROPS,MM,MMM S:$L(SROPER)<50 SROPS(1)=SROPER I $L(SROPER)>49 S SROPER=SROPER_" " F M=1:1 D LOOP Q:MMM=""
|
|
S SRPRIN=$S($D(^SRF(SRTN,.3)):$P(^(.3),"^"),1:"") I SRPRIN'="" S SRPRIN=$P(^VA(200,SRPRIN,0),"^")
|
|
S Y=$P($G(^SRF(SRTN,1.1)),"^",3),C=$P(^DD(130,1.13,0),"^",2) D:Y'="" Y^DIQ S SRASA=$P(Y,"-",2,3)
|
|
K SRTECH S (SRT,SRZ)=0 F S SRT=$O(^SRF(SRTN,6,SRT)) Q:SRT=""!(SRZ) D ^SROPRIN I SRZ D AGENT
|
|
I '$D(SRTECH) S (SRTECH,SRAGNT)=""
|
|
S:'$D(SRAGNT) SRAGNT=""
|
|
I SRTECH'="" S Y=SRTECH,C=$P(^DD(130.06,.01,0),"^",2) D Y^DIQ S SRTECH=Y
|
|
I $D(^SRF(SRTN,.2)) S S(.2)=^(.2),SRANE1=$P(S(.2),"^",1),SRANE2=$P(S(.2),"^",4) S X1=SRANE2,X=SRANE1 I X1,X D MINS^SRSUTL2 S SRANE3=X
|
|
S:'$D(SRANE3) SRANE3="" I '$D(S(.2)) S (SRANE1,SRANE2)=""
|
|
I SRANE1 S Y=SRANE1 D D^DIQ S SRFIND=$F(Y,":"),SRANE1=$S(SRFIND:$E(Y,SRFIND-3,SRFIND+1),1:"")
|
|
I SRANE2 S Y=SRANE2 D D^DIQ S SRFIND=$F(Y,":"),SRANE2=$S(SRFIND:$E(Y,SRFIND-3,SRFIND+1),1:"")
|
|
PRINT ; print results
|
|
I $Y+7>IOSL D PAGE
|
|
Q:SRF W !,SRDATE,?16,SRDPT,?40,SRICD,?97,$E(SRPRIN,1,15),?118,SRANE1,!,SRTN,?16,VA("PID"),?40,SROPS(1),?97,$E(SRTECH,1,20),?118,SRANE2
|
|
W ! W:SRFLG=3&(SRNON) "NON-O.R." W ?16,SRASA W:$D(SROPS(2)) ?40,SROPS(2) W ?97,$E(SRAGNT,1,20),?118,SRANE3,!
|
|
I $D(SROPS(3)) W ?40,SROPS(3),! I $D(SROPS(4)) W ?40,SROPS(4),! I $D(SROPS(5)) W ?40,SROPS(5),! I $D(SROPS(6)) W ?40,SROPS(6),!
|
|
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
|
|
LOOP ; break procedure name if greater than 50 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)'<50 S SROPS(M)=SROPS(M)_MM_" ",SROPER=MMM
|
|
Q
|
|
AGENT S SRAGNT=$O(^SRF(SRTN,6,SRT,1,0)) Q:SRAGNT="" S SRAGNT=$P(^SRF(SRTN,6,SRT,1,SRAGNT,0),"^") D
|
|
.D DATA^PSS50(SRAGNT,,,,,"SRRX") S SRAGNT=$P($G(^TMP($J,"SRRX",SRAGNT,.01)),"^") K ^TMP($J,"SRRX",SRAGNT)
|
|
Q
|
|
BEG ;
|
|
U IO N SRFRTO S SRED1=SRED_.9999,SRF=0,PAGE=1,Y=DT X ^DD("DD") S SRPRINT="DATE PRINTED: "_Y S Y=SRSD X ^DD("DD") S SRFRTO="FROM: "_Y_" TO: ",Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_Y
|
|
S SRINST=SRSITE("SITE"),SRINSTP=SRSITE("DIV") D HDR^SROANP1 Q:SRF
|
|
S DATE=SRSD-.0009 F S DATE=$O(^SRF("AC",DATE)) Q:DATE>SRED1!(DATE="")!SRF S SRTN=0 F S SRTN=$O(^SRF("AC",DATE,SRTN)) Q:SRTN=""!SRF I $D(^SRF(SRTN,0)),$$DIV^SROUTL0(SRTN) D SET
|
|
Q
|
|
PAGE I $E(IOST)'="P" W !!,"Press RETURN to continue, '^' to quit " R ASK:DTIME I '$T!(ASK="^") S SRF=1 Q
|
|
D HDR^SROANP1 Q
|