source: WorldVistAEHR/trunk/r/SURGERY-SR/SROQ0.m@ 1006

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1SROQ0 ;BIR/ADM - QUARTERLY REPORT (CONTINUED) ;03/21/06
2 ;;3.0; Surgery ;**62,70,77,50,95,123,129,153**;24 Jun 93;Build 11
3 ;** NOTICE: This routine is part of an implementation of a nationally
4 ;** controlled procedure. Local modifications to this routine
5 ;** are prohibited.
6 ;
7 ; Reference to ^DIC(45.3 supported by DBIA #218
8 ;
9 S SR(0)=^SRF(SRTN,0),DFN=$P(SR(0),"^") I '$D(^TMP("SRDPT",$J,DFN)) S ^TMP("SRDPT",$J,DFN)="",SRDPT=SRDPT+1
10 D DEM^VADPT S X1=SRSD,X2=$P(VADM(3),"^"),SRAGE=$E(X1,1,3)-$E(X2,1,3)-($E(X1,4,7)<$E(X2,4,7)) I SRAGE>60 S SR60=SR60+1
11 S SRDEATH=0,SRREL="" I $P(VADM(6),"^"),SRSD<$P(VADM(6),"^") S X1=SRSD,X2=30 D C^%DTC I $P(VADM(6),"^")'>X S SRDEATH=1
12 I SRDEATH S ^TMP("SRDTH",$J,DFN)=""
13 S SRMM=$P(SR(0),"^",3) I SRMM="J" S SRMAJOR=SRMAJOR+1
14 S SRIOSTAT=$P(SR(0),"^",12) I SRIOSTAT'="I"&(SRIOSTAT'="O") S VAIP("D")=SRSD D IN5^VADPT S SRIOSTAT=$S(VAIP(13):"I",1:"O") K VAIP
15 I SRIOSTAT="I" S SRINPAT=SRINPAT+1
16 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,"-")
17 S SREM=$P(SR(0),"^",10) I SREM="EM"!(SRASA["E") S SREMERG=SREMERG+1
18COMP ; check for post-op complications
19 S SRPOC=0 I $O(^SRF(SRTN,16,0)) S SRPOC=1,SRCOMP=SRCOMP+1
20ASA ; find ASA class for major procedures
21 I SRMM="J" S Z=$E(SRASA) S:Z="" Z=7 S SRASA(Z)=SRASA(Z)+1
22SP ; find specialty data
23 S X=$P(SR(0),"^",4),Y=$S(X:$P(^SRO(137.45,X,0),"^",2),1:"ZZ") S SRSS=$S(Y:$P(^DIC(45.3,Y,0),"^"),1:Y) I '$D(SRSPEC(SRSS)) S SRSS="ZZ"
24 F I=1:1:4 S SRP(I)=$P(^TMP("SRSS",$J,SRSS),"^",I)
25 I '$D(^TMP("SRDPT",$J,DFN,SRSS)) S ^TMP("SRDPT",$J,DFN,SRSS)="",SRP(1)=SRP(1)+1
26 S SRP(2)=SRP(2)+1 S:SRMM="J" SRP(3)=SRP(3)+1 S:SRMM'="J" SRP(4)=SRP(4)+1
27 S ^TMP("SRSS",$J,SRSS)=SRP(1)_"^"_SRP(2)_"^"_SRP(3)_"^"_SRP(4) K SRP
28 D ^SROQ0A
29WC ; clean wound ?
30 S SRCLEAN=0 I $P($G(^SRF(SRTN,"1.0")),"^",8)="C" S SRWC=SRWC+1,SRCLEAN=1
31CAT ; complication categories
32 S SRW=0
33 I SRPOC S SRC=0 F S SRC=$O(^SRF(SRTN,16,SRC)) Q:'SRC S SRCAT=$P(^SRF(SRTN,16,SRC,0),"^",2) I SRCAT D
34 .S SRC(SRCAT)=SRC(SRCAT)+1 I SRCLEAN,(SRCAT=1!(SRCAT=2)) S SRW=1
35 I $O(^SRF(SRTN,10,0)) S SRC=0 F S SRC=$O(^SRF(SRTN,10,SRC)) Q:'SRC S SRCAT=$P(^SRF(SRTN,10,SRC,0),"^",2) I SRCAT D
36 .S SRC(SRCAT)=SRC(SRCAT)+1 I SRCLEAN,(SRCAT=1!(SRCAT=2)) S SRW=1
37 I SRW S SRIN=SRIN+1
38ENSURE ; check ensuring correct surgery compliance
39 S SRVER=$G(^SRF(SRTN,"VER"))
40TOV ; process time out verified field
41 S SR71=$P(SRVER,"^",3) D
42 .I SR71="Y" S SRTOV=SRTOV+1 Q
43 .I SR71="N" S SRTONO=SRTONO+1 Q
44 .S SRTONE=SRTONE+1
45IC ; process imaging confirmed field
46 S SR72=$P(SRVER,"^",4) D
47 .I SR72="Y" S SRICY=SRICY+1 Q
48 .I SR72="I" S SRICNR=SRICNR+1 Q
49 .I SR72="N" S SRICNO=SRICNO+1 Q
50 .S SRICNE=SRICNE+1
51MRK ; process mark on surgical site confirmed field
52 S SR73=$P(SRVER,"^",5) D
53 .I SR73="Y" S SRSCY=SRSCY+1 Q
54 .I SR73="M" S SRSCNR=SRSCNR+1 Q
55 .I SR73="N" S SRSCNO=SRSCNO+1 Q
56 .S SRSCNE=SRSCNE+1
57HAIR ; process hair removal method
58 S X=$P(SRVER,"^",6) I X="" S X="ZZ"
59 I $D(SRHAIR(X)) S SRHAIR(X)=SRHAIR(X)+1 Q
60 S SRHAIR("ZZ")=SRHAIR("ZZ")+1
61 Q
62HDR ; print page header
63 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
64 I SRHDR,$E(IOST,1,2)="C-" W !!,"Press RETURN to continue, or '^' to quit: " R X:DTIME I '$T!(X["^") S SRSOUT=1 Q
65 S SRHDR=1 I $E(IOST)'="P" W @IOF Q
66 S SRPAGE=SRPAGE+1 I 'SRFLG D HDR1 Q
67 W:$Y @IOF W !,?23,"QUARTERLY REPORT - SURGICAL SERVICE",?76,"PAGE",!,?35,"VERSION 3.0",?78,SRPAGE
68 I SRINST["ALL DIV" W !!,?(80-$L("Hospital: "_SRINST)\2),"Hospital: ",SRINST,!,?30,"Station Number: ",SRSTATN
69 I SRINST'["ALL DIV" W !!,?3,"Hospital: ",SRINST,?55,"Station Number: ",SRSTATN
70 W !,?3,"For Dates: ",SRSD,?32,"to: ",SRED,?55,"Fiscal Year: ",SRYR,! F I=1:1:80 W "="
71 Q
72HDR1 ; print header if not quarterly report
73 I $D(ZTQUEUED) D ^SROSTOP I SRHALT S SRSOUT=1 Q
74 W:$Y @IOF W !,?24,"SUMMARY REPORT - SURGICAL SERVICE",?76,"PAGE",!,?35,"VERSION 3.0",?78,SRPAGE
75 W !!,?(80-$L("Hospital: "_SRINST)\2),"Hospital: ",SRINST,!,?30,"Station Number: ",SRSTATN
76 W !,?20,"For Dates: ",SRSD," to: ",SRED I $E(IOST)="P" W ! F I=1:1:80 W "="
77 Q
Note: See TracBrowser for help on using the repository browser.