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