source: FOIAVistA/trunk/r/SURGERY-SR/SROPPC.m@ 749

Last change on this file since 749 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1SROPPC ;B'HAM ISC/MAM - COMPARISON DIAGNOSIS REPORT ; [ 09/22/98 11:36 AM ]
2 ;;3.0; Surgery ;**77,50**;24 Jun 93
3CHK ; compare pre and postop diagnosis
4 Q:'$D(^SRF(K,.2)) I '$P(^SRF(K,.2),"^",12) Q
5 S SRTN=K K SRPRE,SRPOST I $D(^SRF(SRTN,33)) S SRPRE("*")=$P(^SRF(SRTN,33),"^"),SRPOST("*")=$P(^SRF(SRTN,34),"^")
6 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),"^")
7 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),"^")
8 S:'$D(SRPRE("*")) SRPRE("*")="" S:'$D(SRPOST("*")) SRPOST("*")="" I SRPRE("*")'=SRPOST("*") S SRF=1
9 Q
10SET ; set variables
11 Q:SRPOST("*")=""!(SRPRE("*")="")
12 S S(0)=^SRF(K,0),SRTN=K,DFN=$P(S(0),"^") D DEM^VADPT S SRNM=VADM(1)
13 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))
14 S:$P(S(0),"^",4)'="" SRTS=$P(^SRO(137.45,$P(S(0),"^",4),0),"^")
15 S:'$D(SRTS) SRTS=""
16PRINT ; print case
17 I $Y+5>IOSL D ASK Q:SRQ
18 I SRTS["(" S SRTS=$P(SRTS,"(")
19 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)
20 W !,?10,SRTS,! W:$D(SRPRE(2)) ?42,SRPRE(2) W:$D(SRPOST(2)) ?84,SRPOST(2)
21 Q
22END W:$E(IOST)="P" @IOF I $D(ZTQUEUED) Q:$G(ZTSTOP) S ZTREQ="@" Q
23 D ^SRSKILL K SRTN D ^%ZISC W @IOF
24 Q
25ASK I $E(IOST,1)'="P" W !!,"Press RETURN to continue or '^' to quit. " R X:DTIME I '$T!(X="^") S SRQ=1 Q
26 D HDR Q
27HDR ; print heading
28 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRQ=1 Q
29 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: "
30 W !,?(132-$L(SRFRTO)\2),SRFRTO,?100,SRPRINT
31 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 "-"
32 Q
33EN ; entry point
34 W @IOF,!,"Comparison of Preoperative and Postoperative Diagnosis",!
35 D DATE^SROUTL(.SRSD,.SRED,.SRQ) G:SRQ END
36 S SRD=SRSD-.0001
37 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))
38 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
39 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
40EN1 ; entry when queued
41 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
42 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
43 I 'SRT W !!,"No data for selected date range."
44 G:SRQ END F Z=$Y:1:(IOSL-10) W !
45 W ! F I=1:1:IOM W "-"
46 W !,"WOUND CLASSIFICATION CODES: ",!,"C: CLEAN, CC: CLEAN/CONTAMINATED, D: CONTAMINATED, I: INFECTED"
47 I $E(IOST)'="P",'SRQ W !!,"Press RETURN to continue " R X:DTIME
48 G END
Note: See TracBrowser for help on using the repository browser.