source: FOIAVistA/trunk/r/WOMENS_HEALTH-WV/WVBRNED1.m@ 1458

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

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1WVBRNED1 ;HCIOFO/FT,JR IHS/ANMC/MWR - BROWSE TX NEEDS PAST DUE; ;2/28/00 15:12
2 ;;1.0;WOMEN'S HEALTH;**10**;Sep 30, 1998
3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
4 ;; DISPLAY CODE FOR BROWSING TX NEEDS. CALLED BY WVBRNED.
5 ;
6DISPLAY ;EP
7 ;---> WVCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.
8 ;---> WVTITLE=TITLE AT TOP OF DISPLAY HEADER.
9 ;---> WVSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
10 ;---> WVCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).
11 ;---> WVCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
12 ;---> WVTAB=6 IF OUTPUT IS TO SCREEN, =3 IF OUTPUT IS TO PRINTER.
13 ;---> WVPRMT(1,Q)=PROMPTS FOR DIR.
14 ;
15 U IO
16 S WVCONF=1
17 S WVTITLE1=$S(WVB=1:"BY NEED DATE",WVB=2:"ALPHABETICALLY",WVB=3:"BY PRIMARY CARE PROVIDER",1:"?")
18 S WVTITLE="* PATIENTS LISTED "_WVTITLE1_" *"
19 D CENTERT^WVUTL5(.WVTITLE)
20 S WVSUBH="SUBHEAD^WVBRNED1"
21 S WVCODE="D EDIT^WVBRNED1 N N D SORT^WVBRNED,COPYGBL^WVBRNED"
22 N N S (WVPOP,N,Z)=0
23 D TOPHEAD^WVUTL7
24 ;---> *SET WVFAC FOR NOW; MAKE WVFAC SELECTABLE IN FUTURE VERSIONS.
25 S WVFAC=DUZ(2)
26 S WVTAB=$S(WVCRT:6,1:3)
27 ;
28NOMATCH ;EP
29 ;---> QUIT IF NO RECORDS MATCH.
30 I '$D(^TMP("WV",$J,1)) D Q
31 .D HEADER5^WVUTL7
32 .K WVPRMT,WVPRMT1,WVPRMTQ,DIR
33 .W !!?5,"No records match the selected criteria.",!
34 .I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF
35 .D ^%ZISC S WVPOP=1
36 ;
37DISPLAY1 ;EP
38 ;---> IF A PROCEDURE IS EDITED ON THE LAST PAGE, GOTO HERE
39 ;---> FROM LINELABEL "END" BELOW.
40 N M,Y
41 D HEADER5^WVUTL7
42 F S N=$O(^TMP("WV",$J,2,N)) Q:'N!(WVPOP) D
43 .I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D
44 ..S WVPAGE=WVPAGE+1
45 ..D HEADER5^WVUTL7
46 .S Y=^TMP("WV",$J,2,N),M=N
47 .;---> DON'T WRITE BROWSE SELECTION#'S IF IO IS NOT A CRT (BRCRT).
48 .W !! W:WVCRT $J(N,3),")" ;BROWSE SELECTION#
49 .W ?WVTAB-2,$P(Y,U) ;SSN#
50 .W ?WVTAB+10,$E($P(Y,U,2),1,16)," " ;NAME
51 .W $$REPEAT^XLFSTR(".",16-$L($P(Y,U,2))) ;CONNECTING DOTS
52 .W:'WVCRT "..." ;ADD DOTS IF NOT A CRT
53 .W ?35,$E($P($P(Y,U,3),","),1,9) ;CASE MANAGER
54 .W ?46,$P(Y,U,4),! ;CERVICAL TX NEED&DATE
55 .;I WVB=3
56 .W ?5,"Pr. Provider => ",$E($$PROVI^WVUTL1A($P(Y,U,6)),1,25) ;PRIMARY CARE PROVIDER
57 .W ?46,$P(Y,U,5) ;BREAST TX NEED&DATE
58 .N WVDFN
59 .S WVDFN=$P(Y,U,6)
60 .W !?5,"Age: "_$$AGE^WVUTL9(WVDFN)_" / Veteran: "_$$VET^WVUTL1A(WVDFN)_" / Eligibility: "_$P($$ELIG^WVUTL9(WVDFN),U,2)
61 ;
62 D:'N
63 .N WVTITLE S WVTITLE="----- End of Report -----"
64 .D CENTERT^WVUTL5(.WVTITLE) W !!,WVTITLE
65 I $D(^TMP("WV",$J,1)) I WVCRT&('$D(IO("S"))) D:'WVPOP DIRZ^WVUTL3 W @IOF
66 ;
67END ;EP
68 D ^%ZISC
69 Q
70 ;
71SUBHEAD ;EP
72 ;---> SUB HEADER FOR PATIENT BROWSE OUTPUT.
73 W !?WVTAB,$$PNLB^WVUTL5(),?WVTAB+10,"PATIENT",?35,"CASE MGR"
74 W ?46,"TREATMENT NEED DUE BY DATE",!
75 W $$REPEAT^XLFSTR("-",80)
76 Q
77 ;
78EDIT ;EP
79 ;---> FROM BROWSE, WVPOP IN TO EDIT AN INDIVIDUAL PATIENT.
80 N WVPRMT,WVPRMT1,WVPRMT2,WVPRMTQ
81 D SETVARS^WVUTL5
82 S X=+X,WVDFN=$P(^TMP("WV",$J,2,X),U,6)
83 S WVN=X N X
84 D SCREEN^WVPATE(WVDFN)
85 ;---> BACK UP 5 RECORDS AFTER EDIT.
86 S N=$S(WVN<6:1,1:WVN-5) K WVN
87 Q
Note: See TracBrowser for help on using the repository browser.