- 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 Feb 19, 2025@00:13:11 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