Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: WVBRNED1

WVBRNED1.m

Go to the documentation of this file.
  1. WVBRNED1 ;HCIOFO/FT,JR IHS/ANMC/MWR - BROWSE TX NEEDS PAST DUE; ;2/28/00 15:12
  1. ;;1.0;WOMEN'S HEALTH;**10**;Sep 30, 1998
  1. ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1. ;; DISPLAY CODE FOR BROWSING TX NEEDS. CALLED BY WVBRNED.
  1. ;
  1. DISPLAY ;EP
  1. ;---> WVCONF=DISPLAY "CONFIDENTIAL PT INFO" BANNER.
  1. ;---> WVTITLE=TITLE AT TOP OF DISPLAY HEADER.
  1. ;---> WVSUBH=CODE TO EXECUTE FOR SUBHEADER (COLUMN TITLES).
  1. ;---> WVCODE=CODE TO EXECUTE AS 3RD PIECE OF DIR(0) (AFTER DIR READ).
  1. ;---> WVCRT=1 IF OUTPUT IS TO SCREEN (ALLOWS SELECTIONS TO EDIT).
  1. ;---> WVTAB=6 IF OUTPUT IS TO SCREEN, =3 IF OUTPUT IS TO PRINTER.
  1. ;---> WVPRMT(1,Q)=PROMPTS FOR DIR.
  1. ;
  1. U IO
  1. S WVCONF=1
  1. S WVTITLE1=$S(WVB=1:"BY NEED DATE",WVB=2:"ALPHABETICALLY",WVB=3:"BY PRIMARY CARE PROVIDER",1:"?")
  1. S WVTITLE="* PATIENTS LISTED "_WVTITLE1_" *"
  1. D CENTERT^WVUTL5(.WVTITLE)
  1. S WVSUBH="SUBHEAD^WVBRNED1"
  1. S WVCODE="D EDIT^WVBRNED1 N N D SORT^WVBRNED,COPYGBL^WVBRNED"
  1. N N S (WVPOP,N,Z)=0
  1. D TOPHEAD^WVUTL7
  1. ;---> *SET WVFAC FOR NOW; MAKE WVFAC SELECTABLE IN FUTURE VERSIONS.
  1. S WVFAC=DUZ(2)
  1. S WVTAB=$S(WVCRT:6,1:3)
  1. ;
  1. NOMATCH ;EP
  1. ;---> QUIT IF NO RECORDS MATCH.
  1. I '$D(^TMP("WV",$J,1)) D Q
  1. .D HEADER5^WVUTL7
  1. .K WVPRMT,WVPRMT1,WVPRMTQ,DIR
  1. .W !!?5,"No records match the selected criteria.",!
  1. .I WVCRT&('$D(IO("S"))) D DIRZ^WVUTL3 W @IOF
  1. .D ^%ZISC S WVPOP=1
  1. ;
  1. DISPLAY1 ;EP
  1. ;---> IF A PROCEDURE IS EDITED ON THE LAST PAGE, GOTO HERE
  1. ;---> FROM LINELABEL "END" BELOW.
  1. N M,Y
  1. D HEADER5^WVUTL7
  1. F S N=$O(^TMP("WV",$J,2,N)) Q:'N!(WVPOP) D
  1. .I $Y+6>IOSL D:WVCRT DIRZ^WVUTL3 Q:WVPOP D
  1. ..S WVPAGE=WVPAGE+1
  1. ..D HEADER5^WVUTL7
  1. .S Y=^TMP("WV",$J,2,N),M=N
  1. .;---> DON'T WRITE BROWSE SELECTION#'S IF IO IS NOT A CRT (BRCRT).
  1. .W !! W:WVCRT $J(N,3),")" ;BROWSE SELECTION#
  1. .W ?WVTAB-2,$P(Y,U) ;SSN#
  1. .W ?WVTAB+10,$E($P(Y,U,2),1,16)," " ;NAME
  1. .W $$REPEAT^XLFSTR(".",16-$L($P(Y,U,2))) ;CONNECTING DOTS
  1. .W:'WVCRT "..." ;ADD DOTS IF NOT A CRT
  1. .W ?35,$E($P($P(Y,U,3),","),1,9) ;CASE MANAGER
  1. .W ?46,$P(Y,U,4),! ;CERVICAL TX NEED&DATE
  1. .;I WVB=3
  1. .W ?5,"Pr. Provider => ",$E($$PROVI^WVUTL1A($P(Y,U,6)),1,25) ;PRIMARY CARE PROVIDER
  1. .W ?46,$P(Y,U,5) ;BREAST TX NEED&DATE
  1. .N WVDFN
  1. .S WVDFN=$P(Y,U,6)
  1. .W !?5,"Age: "_$$AGE^WVUTL9(WVDFN)_" / Veteran: "_$$VET^WVUTL1A(WVDFN)_" / Eligibility: "_$P($$ELIG^WVUTL9(WVDFN),U,2)
  1. ;
  1. D:'N
  1. .N WVTITLE S WVTITLE="----- End of Report -----"
  1. .D CENTERT^WVUTL5(.WVTITLE) W !!,WVTITLE
  1. I $D(^TMP("WV",$J,1)) I WVCRT&('$D(IO("S"))) D:'WVPOP DIRZ^WVUTL3 W @IOF
  1. ;
  1. END ;EP
  1. D ^%ZISC
  1. Q
  1. ;
  1. SUBHEAD ;EP
  1. ;---> SUB HEADER FOR PATIENT BROWSE OUTPUT.
  1. W !?WVTAB,$$PNLB^WVUTL5(),?WVTAB+10,"PATIENT",?35,"CASE MGR"
  1. W ?46,"TREATMENT NEED DUE BY DATE",!
  1. W $$REPEAT^XLFSTR("-",80)
  1. Q
  1. ;
  1. EDIT ;EP
  1. ;---> FROM BROWSE, WVPOP IN TO EDIT AN INDIVIDUAL PATIENT.
  1. N WVPRMT,WVPRMT1,WVPRMT2,WVPRMTQ
  1. D SETVARS^WVUTL5
  1. S X=+X,WVDFN=$P(^TMP("WV",$J,2,X),U,6)
  1. S WVN=X N X
  1. D SCREEN^WVPATE(WVDFN)
  1. ;---> BACK UP 5 RECORDS AFTER EDIT.
  1. S N=$S(WVN<6:1,1:WVN-5) K WVN
  1. Q