- 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
