1 | WVPRPCD ;HCIOFO/FT,JR-WV PRINT A PROCEDURE; ;8/5/99 15:58
|
---|
2 | ;;1.0;WOMEN'S HEALTH;**6,7**;Sep 30, 1998
|
---|
3 | ;; Original routine created by IHS/ANMC/MWR
|
---|
4 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
---|
5 | ;; DISPLAY CODE FOR PRINTING PROCEDURES. ENTRY POINTS FOR PRINTING
|
---|
6 | ;; INDIVIDUAL PROCEDURES AND ALL NEW PROCEDURES.
|
---|
7 | ;
|
---|
8 | TOP(DA) ;EP
|
---|
9 | ;---> PRINT PROCEDURE (NOT CALLED BY ANY OPTION).
|
---|
10 | ;---> REQUIRED VARIABLE: DA=IEN OF PROCEDURE IN PROC FILE 790.1.
|
---|
11 | ;
|
---|
12 | D SETVARS^WVUTL5
|
---|
13 | D DEVICE Q:WVPOP
|
---|
14 | D START(DA)
|
---|
15 | D ^%ZISC
|
---|
16 | W @IOF
|
---|
17 | Q
|
---|
18 | ;
|
---|
19 | ;
|
---|
20 | STARTQ ;EP
|
---|
21 | ;---> ENTRY POINT FOR TASKMAN--CANNOT PASS PARAMETERS.
|
---|
22 | ;---> REQUIRED VARIABLE: DA=IEN OF PROCEDURE IN PROC FILE 790.1.
|
---|
23 | D START(DA)
|
---|
24 | Q
|
---|
25 | ;
|
---|
26 | ;
|
---|
27 | START(DA) ;EP
|
---|
28 | N WVPRMT1,WVTITLE,WVY,N,X
|
---|
29 | D SETVARS^WVUTL5
|
---|
30 | S WVSL="I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D HEADER4^WVUTL7"
|
---|
31 | D TOPHEAD^WVUTL7,PCDVARS^WVUTL3(DA)
|
---|
32 | ;---> WVCRT=1 IF OUTPUT IS TO SCREEN (SET BY TOPHEAD^WVUTL7).
|
---|
33 | S WVTITLE1="* * * WOMEN'S HEALTH: PROCEDURE PRINTOUT * * *"
|
---|
34 | D CENTERT^WVUTL5(.WVTITLE1)
|
---|
35 | S WVPRMT1=" Press RETURN to continue or '^'to exit, or"
|
---|
36 | S WVY=^WV(790.1,DA,0),WVDFN=$P(WVY,U,2)
|
---|
37 | ;
|
---|
38 | U IO
|
---|
39 | D HEADER4^WVUTL7 W:'WVCRT !
|
---|
40 | W !?5,"Date of Procedure: ",$$TXDT^WVUTL5($P(WVY,U,12))
|
---|
41 | W !?4,"Date First Entered: ",$$TXDT^WVUTL5($P(WVY,U,19))
|
---|
42 | W ?42,"First Entered By: " S X=$P(WVY,U,18) W $E($$PROV^WVUTL6,1,20)
|
---|
43 | W ! W:$P(WVY,U,15)]"" ?43,"Radiology Case#: ",$P(WVY,U,15)
|
---|
44 | S X=$P($G(^WV(790.1,DA,2)),U,17) ;lab accession#
|
---|
45 | W:X]"" ?44,"Lab Accession#: ",X
|
---|
46 | W !?4,"Clinician/Provider: ",WVPROV
|
---|
47 | W !?2,"Ward/Clinic/Location: " S X=$P(WVY,U,11) W $$HOSPLC^WVUTL6
|
---|
48 | W !?2,"Health Care Facility: " S X=$P(WVY,U,10) W $$INSTTX^WVUTL6(X)
|
---|
49 | W !?14,"Comments: "
|
---|
50 | ;---> WRITE OUT CLINICAL HISTORY; IF TWO LINES, SPLIT BETWEEN WORDS.
|
---|
51 | D
|
---|
52 | .Q:'$D(^WV(790.1,DA,3))
|
---|
53 | .N L,Y
|
---|
54 | .S Y=$P(^WV(790.1,DA,3),U)
|
---|
55 | .I $L(Y)<57 W Y,! Q
|
---|
56 | .S L=56 I Y[" " F Q:$E(Y,L)=" " S L=L-1
|
---|
57 | .W $E(Y,1,L),! W:$L(Y)>56 ?24,$E(Y,L+1,109)
|
---|
58 | ;
|
---|
59 | W !?4,"Complete by (Date): ",$$TXDT^WVUTL5($P(WVY,U,13))
|
---|
60 | W !?5,"Results/Diagnosis: ",WVRES
|
---|
61 | W !," Sec Results/diagnosis: " W $$DIAG^WVUTL4($P(WVY,U,6))
|
---|
62 | W ?57,"HPV: " W:$P(WVY,U,8) "YES"
|
---|
63 | W !?16,"Status: " S Y=WVY W $$STATUS^WVUTL4
|
---|
64 | ;
|
---|
65 | ;---> IF THIS PROCEDURE HAS COLPOSCOPY-TYPE RESULTS, DISPLAY COLP PAGE.
|
---|
66 | D:$$COLP^WVUTL4(DA) Q:WVPOP
|
---|
67 | .I WVCRT D DIRZ^WVUTL3 Q:WVPOP D HEADER4^WVUTL7
|
---|
68 | .S WVTITLE="----- CLINICAL FINDINGS -----"
|
---|
69 | .D CENTERT^WVUTL5(.WVTITLE) W !!,WVTITLE
|
---|
70 | .;
|
---|
71 | .X WVSL Q:WVPOP W !?2,"T-Zone Seen Entirely: "
|
---|
72 | .W $S($P(WVY,U,21):"YES",$P(WVY,U,21)=0:"NO",1:"")
|
---|
73 | .W ?54,"Multifocal: "
|
---|
74 | .W $S($P(WVY,U,21):"YES",$P(WVY,U,21)=0:"NO",1:"")
|
---|
75 | .;
|
---|
76 | .X WVSL Q:WVPOP W !?2,"Lesion Outside Canal: "
|
---|
77 | .W $S($P(WVY,U,22):"YES",$P(WVY,U,22)=0:"NO",1:"")
|
---|
78 | .W ?45,"Number of Quadrants: " W $P(WVY,U,24)
|
---|
79 | .;
|
---|
80 | .X WVSL Q:WVPOP W !?5,"Satisfactory Exam: "
|
---|
81 | .W $S($P(WVY,U,20):"YES",$P(WVY,U,20)=0:"NO",1:"")
|
---|
82 | .W ?46,"Quadrant Locations: ",$P($G(^WV(790.1,DA,2)),U,16)
|
---|
83 | .X WVSL Q:WVPOP W !?12,"Impression: "
|
---|
84 | .W $$DIAG^WVUTL4($P(WVY,U,29))
|
---|
85 | .;
|
---|
86 | .X WVSL Q:WVPOP S WVTITLE="----- TISSUE PATHOLOGY -----"
|
---|
87 | .D CENTERT^WVUTL5(.WVTITLE) W !!,WVTITLE
|
---|
88 | .;
|
---|
89 | .X WVSL Q:WVPOP W !?9,"ECC Dysplasia: "
|
---|
90 | .S X=$P(WVY,U,25) W $$ECCDYS^WVUTL6
|
---|
91 | .W ?57,"Margins Clear: "
|
---|
92 | .W $S($P(WVY,U,27):"YES",$P(WVY,U,27)=0:"NO",1:"") X WVSL Q:WVPOP
|
---|
93 | .X WVSL Q:WVPOP W !?3,"Ectocervical Biopsy: "
|
---|
94 | .W $$DIAG^WVUTL4($P(WVY,U,26))
|
---|
95 | .W ?57,"Stage: "
|
---|
96 | .W $$STAGE^WVUTL4($P(WVY,U,31)) X WVSL Q:WVPOP
|
---|
97 | .X WVSL Q:WVPOP W !?8,"STD Evaluation: "
|
---|
98 | .W $$DIAG^WVUTL4($P(WVY,U,28))
|
---|
99 | ;
|
---|
100 | I WVCRT D DIRZ^WVUTL3 Q:WVPOP D HEADER4^WVUTL7
|
---|
101 | S WVTITLE="----- NOTES ----- "
|
---|
102 | D CENTERT^WVUTL5(.WVTITLE) W !!,WVTITLE,!
|
---|
103 | S WVTITLE="----- NOTES (continued) -----"
|
---|
104 | D CENTERT^WVUTL5(.WVTITLE) S WVSUBH=WVTITLE
|
---|
105 | S N=0
|
---|
106 | F S N=$O(^WV(790.1,DA,1,N)) Q:'N!(WVPOP) D
|
---|
107 | .X WVSL Q:WVPOP
|
---|
108 | .W !,^WV(790.1,DA,1,N,0)
|
---|
109 | S WVTITLE="----- End of Procedure Printout -----"
|
---|
110 | D CENTERT^WVUTL5(.WVTITLE) W !!,WVTITLE
|
---|
111 | K WVSUBH
|
---|
112 | I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3 W @IOF
|
---|
113 | Q
|
---|
114 | ;
|
---|
115 | DEVICE ;EP
|
---|
116 | ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
|
---|
117 | S ZTRTN="STARTQ^WVPRPCD",ZTSAVE("DA")=""
|
---|
118 | D ZIS^WVUTL2(.WVPOP,1)
|
---|
119 | Q
|
---|
120 | ;
|
---|
121 | JUSTPRT ;EP
|
---|
122 | ;---> CALLED BY OPTION: "WV PRINT INDIVIDUAL PROCEDURES".
|
---|
123 | ;---> JUST PRINT AN INDIVIDUAL PROCEDURE.
|
---|
124 | N DA,Y
|
---|
125 | F D Q:Y<0
|
---|
126 | .D TITLE^WVUTL5("PRINT A PROCEDURE")
|
---|
127 | .D LKUPPCD^WVPROC(.Y)
|
---|
128 | .Q:Y<0
|
---|
129 | .D TOP(+Y)
|
---|
130 | D EXIT
|
---|
131 | Q
|
---|
132 | ;
|
---|
133 | PRTNEW ;EP
|
---|
134 | ;---> CALLED BY OPTION: "WV PRINT ALL NEW PROCEDURES".
|
---|
135 | ;---> PRINT ALL PROCEDURES WITH A STATUS OF "NEW" (NEW UPLOADED
|
---|
136 | ;---> LAB RESULTS).
|
---|
137 | D TITLE^WVUTL5("PRINT ALL ""NEW"" PROCEDURES")
|
---|
138 | S ZTRTN="DEQUEUE^WVPRPCD"
|
---|
139 | D ZIS^WVUTL2(.WVPOP,1)
|
---|
140 | Q:WVPOP
|
---|
141 | ;
|
---|
142 | DEQUEUE ;EP
|
---|
143 | ;---> FOR TASKMAN QUEUE OF PRINTOUT.
|
---|
144 | S N=0
|
---|
145 | F S N=$O(^WV(790.1,"S","n",N)) Q:'N D
|
---|
146 | .D START(N)
|
---|
147 | D ^%ZISC,EXIT
|
---|
148 | Q
|
---|
149 | ;
|
---|
150 | EXIT ;EP
|
---|
151 | D KILLALL^WVUTL8
|
---|
152 | Q
|
---|