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