source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVPROF3.m@ 724

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1WVPROF3 ;HCIOFO/FT,JR IHS/ANMC/MWR - DISPLAY PATIENT PROFILE; ;7/30/98 16:39
2 ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
4 ;; DISPLAY CODE FOR PATIENT PROFILE. CALLED BY WVPROF1.
5 ;
6NOMATCH ;EP
7 ;---> QUIT IF NO RECORDS MATCH.
8 N M
9 I '$D(^TMP("WV",$J,1)) D Q
10 .D HEADER2^WVUTL7
11 .K WVPRMT,WVPRMT1,WVPRMTQ,DIR
12 .W !!?5,"No records match the selected criteria.",!
13 .I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF
14 .D ^%ZISC S WVPOP=1
15 ;
16 ;---> WVD=1:DETAILED DISPLAY, WVD=0:BRIEF DISPLAY.
17 I WVD D DISPLAY1 Q
18 D DISPLAY2
19 Q
20 ;
21 ;
22DISPLAY1 ;EP
23 ;---> IF A PROCEDURE IS EDITED ON THE LAST PAGE, GOTO HERE
24 ;---> FROM LINELABEL "END" BELOW.
25 D HEADER2^WVUTL7
26 F S N=$O(^TMP("WV",$J,2,N)) Q:'N!(WVPOP) D
27 .I $Y+5>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D
28 ..S WVPAGE=WVPAGE+1
29 ..D HEADER2^WVUTL7 S (WVACCP,Z)=0
30 .S Y=^TMP("WV",$J,2,N),M=N
31 .W !
32 .;
33 .;---> **********************
34 .;---> DISPLAY PROCEDURES
35 .;---> IF PIECE 1=1 DISPLAY AS A PROCEDURE.
36 .I $P(Y,U)=1 D Q
37 ..W !,"------------------------------< "
38 ..W "PROCEDURE: ",$P(Y,U,5)," >" ;PROCEDURE ABBREVIATION
39 ..W $$REPEAT^XLFSTR("-",(6-$L($P(Y,U,5))))
40 ..;F I=1:1:(6-$L($P(Y,U,5))) W "-"
41 ..W "-----------------------------"
42 ..W ! W:WVCRT $J(N,3),")" W ?WVTAB ;BROWSE SELECTION#
43 ..W $P(Y,U,6) ;ACCESSION#
44 ..W ?17,$P(Y,U,4) ;DATE OF PROCEDURE
45 ..W ?27,"Res/Diag: ",$P(Y,U,7) ;RESULTS/DIAGNOSIS
46 ..W !?27,"Provider: ",$E($P(Y,U,8),1,14) ;PROVIDER
47 ..W ?62,"Status: ",$P(Y,U,9) ;STATUS
48 ..S WVACCP=$P(Y,U,6) ;STORE AS PREVIOUS ACCESS#
49 .;
50 .;---> **********************
51 .;---> DISPLAY NOTIFICATIONS
52 .;---> IF PIECE 1=2 DISPLAY AS A NOTIFICATION.
53 .I $P(Y,U)=2 D Q
54 ..S WVACC=$P(Y,U,5)
55 ..I WVACC'=Z D
56 ...W ! W:WVACC["NO ACC#" "-----------------" W ?17
57 ...W "-------------< NOTIFICATIONS >---------------------------------"
58 ..W ! W:WVCRT $J(N,3),")" W ?WVTAB ;BROWSE SELECTION#
59 ..W:WVACC'=WVACCP!(WVACC["NO ACC#") WVACC ;ACCESSION#
60 ..W ?17,$P(Y,U,4) ;DATE OF PROCEDURE
61 ..W ?27,$E($P(Y,U,6)_": "_$P(Y,U,7),1,53) ;TYPE AND PURPOSE
62 ..W !?27,"Outcome: ",$E($P(Y,U,8),1,23) ;OUTCOME OF NOTIFICATION
63 ..W ?62,"Status: ",$P(Y,U,9) ;STATUS
64 ..S (WVACCP,Z)=WVACC ;STORE AS PREVIOUS ACC#
65 ..;
66 ..;---> TWO VARIABLES (WVACCP & Z) USED ABOVE: "Z" SAYS "IF THIS NOTIF
67 ..;---> ACC# IS NOT THE SAME AS THE LAST ONE, DISPLAY --<NOT>-- BANNER.
68 ..;---> "WVACCP" SAYS "IF THIS NOTIF ACC# MATCHES THE LAST PROCEDURE'S
69 ..;---> ACC#, DON'T DISPLAY THE ACCESSION#."
70 ..;---> BOTH VARIABLES ARE RESET AFTER A FORMFEED, IN ORDER TO DISPLAY
71 ..;---> ON THE NEW PAGE.
72 .;
73 .;---> **********************
74 .;---> DISPLAY PAP REGIMENS
75 .;---> IF PIECE 1=3 DISPLAY AS A PAP REGIMEN.
76 .I $P(Y,U)=3 D Q
77 ..W !,"------------------------------< PAP REGIMEN CHANGE"
78 ..W " >----------------------------"
79 ..W !?10,"Began:"
80 ..W ?17,$P(Y,U,4) ;DATE OF REGIMEN ENTRY
81 ..W ?27,"Regimen: ",$P(Y,U,5) ;PAP REGIMEN
82 .;
83 .;---> **********************
84 .;---> DISPLAY PREGNANCIES
85 .;---> IF PIECE 1=4 DISPLAY AS A PREGNANCY.
86 .I $P(Y,U)=4 D Q
87 ..W !,"------------------------------< PREGNANCY STATUS"
88 ..W " >------------------------------"
89 ..W !?8,"Entered:"
90 ..W ?17,$P(Y,U,4) ;DATE OF PREGNANCY EDIT.
91 ..W ?27,$P(Y,U,5) ;PREGNANT/NOT
92 ..W:$P(Y,U,6)]"" ?50,"EDC: ",$P(Y,U,6) ;EDC
93 ;
94END ;EP
95 ;---> IF A PROCEDURE HAS BEEN EDITED, SET N=N-5 AND START (GOTO)
96 ;---> DISPLAY1 OVER AGAIN FROM 5 RECORDS PREVIOUS.
97 I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3 I N S N=N-1 G NOMATCH
98 D ^%ZISC
99 K N,Z
100 Q
101 ;
102 ;
103 ;
104DISPLAY2 ;EP
105 ;---> IF A PROCEDURE IS EDITED ON THE LAST PAGE, GOTO HERE
106 ;---> FROM LINELABEL "END" BELOW.
107 S WVSUBH="SUBHEAD^WVPROF1"
108 D HEADER2^WVUTL7
109 F S N=$O(^TMP("WV",$J,2,N)) Q:'N!(WVPOP) D
110 .I $Y+5>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D
111 ..S WVPAGE=WVPAGE+1
112 ..D HEADER2^WVUTL7 S (WVACCP,Z)=0
113 .S Y=^TMP("WV",$J,2,N),M=N
114 .;---> QUIT IF NOT A PROCEDURE (PIECE 1'=1).
115 .Q:$P(Y,U)'=1
116 .W ! W:WVCRT $J(N,3),")" W ?WVTAB ;BROWSE SELECTION#
117 .W $P(Y,U,4) ;DATE OF PROCEDURE
118 .W ?17,$P(Y,U,5) ;PROCEDURE ABBREVIATION
119 .W ?27,$P(Y,U,7) ;RESULT
120 .W ?71,$P(Y,U,9) ;STATUS
121 .S WVACCP=$P(Y,U,6) ;STORE AS PREVIOUS ACCESS#
122END2 ;EP
123 ;---> IF A PROCEDURE HAS BEEN EDITED, SET N=N-1 AND START (GOTO)
124 ;---> DISPLAY2 OVER AGAIN FROM 5 RECORDS PREVIOUS.
125 I WVCRT&('$D(IO("S")))&('WVPOP) D DIRZ^WVUTL3 I N S N=N-1 G NOMATCH
126 D ^%ZISC
127 K N,Z
128 Q
Note: See TracBrowser for help on using the repository browser.