49 lines
3.1 KiB
Mathematica
49 lines
3.1 KiB
Mathematica
SROPPC ;B'HAM ISC/MAM - COMPARISON DIAGNOSIS REPORT ; [ 09/22/98 11:36 AM ]
|
|
;;3.0; Surgery ;**77,50**;24 Jun 93
|
|
CHK ; compare pre and postop diagnosis
|
|
Q:'$D(^SRF(K,.2)) I '$P(^SRF(K,.2),"^",12) Q
|
|
S SRTN=K K SRPRE,SRPOST I $D(^SRF(SRTN,33)) S SRPRE("*")=$P(^SRF(SRTN,33),"^"),SRPOST("*")=$P(^SRF(SRTN,34),"^")
|
|
S (SRDG,CNT)=0 F S SRDG=$O(^SRF(SRTN,14,SRDG)) Q:SRDG="" S CNT=CNT+1,SRPRE(CNT)=$P(^SRF(SRTN,14,SRDG,0),"^")
|
|
S (CNT,SRDG)=0 F S SRDG=$O(^SRF(SRTN,15,SRDG)) Q:SRDG="" S CNT=CNT+1,SRPOST(CNT)=$P(^SRF(SRTN,15,SRDG,0),"^")
|
|
S:'$D(SRPRE("*")) SRPRE("*")="" S:'$D(SRPOST("*")) SRPOST("*")="" I SRPRE("*")'=SRPOST("*") S SRF=1
|
|
Q
|
|
SET ; set variables
|
|
Q:SRPOST("*")=""!(SRPRE("*")="")
|
|
S S(0)=^SRF(K,0),SRTN=K,DFN=$P(S(0),"^") D DEM^VADPT S SRNM=VADM(1)
|
|
S SROD=$E($P(S(0),"^",9),4,5)_"/"_$E($P(S(0),"^",9),6,7)_"/"_$E($P(S(0),"^",9),2,3),SRWC=$S('$D(^SRF(K,"1.0")):"",1:$P(^("1.0"),"^",8))
|
|
S:$P(S(0),"^",4)'="" SRTS=$P(^SRO(137.45,$P(S(0),"^",4),0),"^")
|
|
S:'$D(SRTS) SRTS=""
|
|
PRINT ; print case
|
|
I $Y+5>IOSL D ASK Q:SRQ
|
|
I SRTS["(" S SRTS=$P(SRTS,"(")
|
|
W !,SROD,?10,SRNM,?42,SRPRE("*"),?84,SRPOST("*") W ?126,SRWC,!,SRTN,?10,VA("PID") W:$D(SRPRE(1)) ?42,SRPRE(1) W:$D(SRPOST(1)) ?84,SRPOST(1)
|
|
W !,?10,SRTS,! W:$D(SRPRE(2)) ?42,SRPRE(2) W:$D(SRPOST(2)) ?84,SRPOST(2)
|
|
Q
|
|
END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
|
|
D ^SRSKILL K SRTN D ^%ZISC W @IOF
|
|
Q
|
|
ASK I $E(IOST,1)'="P" W !!,"Press RETURN to continue or '^' to quit. " R X:DTIME I '$T!(X="^") S SRQ=1 Q
|
|
D HDR Q
|
|
HDR ; print heading
|
|
I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRQ=1 Q
|
|
W:$Y @IOF W !,?(132-$L(SRINST)\2),SRINST,!,?58,"SURGICAL SERVICE",?100,"REVIEWED BY: ",!,?46,"COMPARISON OF PREOP AND POSTOP DIAGNOSIS",?100,"DATE REVIEWED: "
|
|
W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,SRPRINT
|
|
W !!,"DATE",?10,"PATIENT",?42,"PREOPERATIVE DIAGNOSIS",?84,"POSTOPERATIVE DIAGNOSIS",?121,"WOUND CLASS",!,"CASE #",?10,"ID #",!,?10,"SURGICAL SPECIALTY",! F I=1:1:IOM W "-"
|
|
Q
|
|
EN ; entry point
|
|
W @IOF,!,"Comparison of Preoperative and Postoperative Diagnosis",!
|
|
D DATE^SROUTL(.SRSD,.SRED,.SRQ) G:SRQ END
|
|
S SRD=SRSD-.0001
|
|
N SRINSTP S SRINST=$$INST^SROUTL0() G:SRINST="^" END S SRINSTP=$P(SRINST,U),SRINST=$S(SRINST["ALL DIVISIONS":SRINST,1:$P(SRINST,U,2))
|
|
K IOP,%ZIS,POP,IO("Q") S %ZIS("A")="Print the Report on which Device: ",%ZIS="QM" W !!,"This report is designed to use a 132 column format.",! D ^%ZIS G:POP END
|
|
I $D(IO("Q")) K IO("Q") S ZTDESC="COMPARE DIAGNOSIS",ZTRTN="EN1^SROPPC",(ZTSAVE("SRED"),ZTSAVE("SRSD"),ZTSAVE("SRINST"),ZTSAVE("SRINSTP"),ZTSAVE("SRD"))="" D ^%ZTLOAD G END
|
|
EN1 ; entry when queued
|
|
U IO N SRFRTO S (SRT,SRQ)=0,J=SRD,Y=SRSD X ^DD("DD") S SRFRTO="FROM: "_Y_" TO: ",Y=SRED X ^DD("DD") S SRFRTO=SRFRTO_Y,Y=DT X ^DD("DD") S SRPRINT="DATE PRINTED: "_Y
|
|
D HDR F S J=$O(^SRF("AC",J)) Q:'J!(J>(SRED+.9999))!SRQ S K=0 F S K=$O(^SRF("AC",J,K)) Q:'K!SRQ I $D(^SRF(K,0)),$$MANDIV^SROUTL0(SRINSTP,K) S SRF=0 D CHK I SRF S SRT=SRT+1 D SET
|
|
I 'SRT W !!,"No data for selected date range."
|
|
G:SRQ END F Z=$Y:1:(IOSL-10) W !
|
|
W ! F I=1:1:IOM W "-"
|
|
W !,"WOUND CLASSIFICATION CODES: ",!,"C: CLEAN, CC: CLEAN/CONTAMINATED, D: CONTAMINATED, I: INFECTED"
|
|
I $E(IOST)'="P",'SRQ W !!,"Press RETURN to continue " R X:DTIME
|
|
G END
|