[613] | 1 | WVBRNED1 ;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 | ;
|
---|
| 6 | DISPLAY ;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 | ;
|
---|
| 28 | NOMATCH ;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 | ;
|
---|
| 37 | DISPLAY1 ;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 | ;
|
---|
| 67 | END ;EP
|
---|
| 68 | D ^%ZISC
|
---|
| 69 | Q
|
---|
| 70 | ;
|
---|
| 71 | SUBHEAD ;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 | ;
|
---|
| 78 | EDIT ;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
|
---|