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

BWUTL7.m

Go to the documentation of this file. 
  1. BWUTL7 ;IHS/ANMC/MWR - UTIL: HEADERS & TRAILERS;23-Jan-2009 10:35;DU
  1.  ;;2.0;WOMEN'S HEALTH;**5,6,8,11**;MAY 16, 1996
  1.  ;IHS/CMI/LAB - spacing 4 digit years
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  UTILITY: HEADERS AND TRAILERS.
  1.  ;
  1. S(S) ;EP
  1.  ;---> RETURN A VALUE OF SPACES EQUAL IN LENGTH TO THE NUMBER S.
  1.  N I,SP S SP="" F I=1:1:8 S SP=SP_"          "
  1.  Q $E(SP,1,$G(S))
  1.  ;
  1. TOPHEAD ;EP
  1.  ;---> CODE TO SET VARIABLES FOR HEADER.
  1.  N X
  1.  D NOW^%DTC S BWNOW=$$SLDT1^BWUTL5(%)
  1.  S BWLINE="" F I=1:1:8 S BWLINE=BWLINE_"----------"
  1.  S BWPAGE=1
  1.  S BWCRT=$S($E(IOST)="C":1,1:0)
  1.  S BWCONFF="*********************** CONFIDENTIAL PATIENT INFORMATION "
  1.  S BWCONFF=BWCONFF_"***********************"
  1.  S BWTIMLN=$E(BWLINE,1,26)_" printed: "_BWNOW_" "_$E(BWLINE,1,27)
  1.  Q
  1.  ;
  1.  ;
  1. HEADER1 ;EP
  1.  ;---> BROWSE/REPORT HEADER: MULTIPLE PATIENTS, MULTIPLE PROCEDURES.
  1.  ;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE,DUZ(2)
  1.  ;---> OPTIONAL VARIABLE:  BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
  1.  N X
  1.  W:BWPAGE>1!BWCRT @IOF,!
  1.  W:$D(BWCONF) BWCONFF,! W:'BWCRT BWTIMLN,!
  1.  W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE
  1.  W !!,"Case Mgr: " D
  1.  .I '$D(BWE) W "ALL" Q
  1.  .I BWE W "ALL" Q
  1.  .I '$D(BWCMGR) W "UNKNOWN" Q
  1.  .I BWCMGR="" W "UNKNOWN" Q
  1.  .I '$D(^VA(200,BWCMGR,0)) W "UNKNOWN" Q
  1.  .W $P(^VA(200,BWCMGR,0),U)
  1.  W ?56,"For period: ",$$TXDT^BWUTL5(BWBEGDT)
  1.  W !,"Facility: ",$$INSTTX^BWUTL6(DUZ(2))
  1.  W ?64,"To: ",$$TXDT^BWUTL5(BWENDDT)
  1.  W ! F I=1:1:80 W "="
  1.  I $D(BWSUBH) D @BWSUBH
  1.  Q
  1.  ;
  1.  ;
  1. HEADER2 ;EP
  1.  ;---> PATIENT REPORT HEADER: ONE PATIENT, MULTIPLE PROCEDURES.
  1.  ;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE,DUZ(2)
  1.  ;---> OPTIONAL VARIABLE:  BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
  1.  N X
  1.  W:BWPAGE>1!BWCRT @IOF,!
  1.  W:$D(BWCONF) BWCONFF,! W:'BWCRT BWTIMLN,!
  1.  W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE
  1.  ;IHS/CMI/THL PATCH 8
  1.  W !!,"Patient Name: ",BWNAMAGE,?55,$$PNLAB^BWUTL5(DUZ(2)),BWCHRT
  1.  W !,"DOB         : ",$$FMTE^XLFDT($$GET1^DIQ(2,BWDFN,.03,"I")),?58,"PCP: ",$E($$GET1^DIQ(9002086,BWDFN,.25),1,16) ; IHS/MSC/BWF - Patch 10
  1.  W !,"Case Manager: ",BWCMGR
  1.  W ?53,"Facility: ",$E($$INSTTX^BWUTL6(DUZ(2)),1,17)
  1.  W !,"Cx Tx Need  : ",BWCNEED
  1.  W ?51,"Inact Date: ",$$SLDT2^BWUTL5($$INACT^BWUTL1(BWDFN))
  1.  ;W ?52,"Period:"                             ;---> XDATES
  1.  ;W ?60,$$SLDT2^BWUTL5(BWBEGDT)," to "        ;---> XDATES
  1.  ;W $$SLDT2^BWUTL5(BWENDDT)                   ;---> XDATES
  1.  W !,"PAP Regimen : ",BWPAPRG
  1.  W ?50,"Income Elig: "
  1.  N X
  1.  S X=$P(^BWP(BWDFN,0),U,29)
  1.  W $S(X=1:"YES",X=2:"NO",X=3:"REFUSED",1:"NOT DETERMINED")
  1.  W !,"Br Tx Need  : ",BWBNEED
  1.  W ?50,"Income Date: "
  1.  N X
  1.  S X=$P(^BWP(BWDFN,0),U,30)
  1.  W $$SLDT2^BWUTL5(X)
  1.  ;W !,"        PCP : "_$$GET1^DIQ(9002086,BWDFN,.25)  ;IHS/CIA/PLS - Patch 11
  1.  ;IHS/CMI/THL END PATCH 8
  1.  W ! F I=1:1:49 W "="
  1.  ;begin Y2K
  1.  W $S(BWEDC]"":BWEDC_"====",1:"===============================") ;IHS/CMI/LAB - format 4 digit year Y2000
  1.  ;end Y2K
  1.  I $D(BWSUBH) D @BWSUBH
  1.  Q
  1.  ;
  1.  ;
  1. HEADER3 ;EP
  1.  ;---> LAB LOG REPORT HEADER: MULTIPLE PATIENTS, MULTIPLE PROCEDURES.
  1.  ;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE,DUZ(2)
  1.  ;---> OPTIONAL VARIABLE:  BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
  1.  N X
  1.  W:BWPAGE>1!BWCRT @IOF,!
  1.  W:$D(BWCONF) BWCONFF,! W:'BWCRT BWTIMLN,!
  1.  W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE
  1.  W !!,"Facility: ",$$INSTTX^BWUTL6($S($G(BWFAC):BWFAC,1:DUZ(2)))
  1.  ;begin Y2K
  1.  W ?49,"From: ",$$SLDT2^BWUTL5(BWBEGDT) ;IHS/CMI/LAB 53 to 49 Y2000
  1.  ;end Y2K
  1.  W " to ",$$SLDT2^BWUTL5(BWENDDT)
  1.  W ! F I=1:1:80 W "="
  1.  I $D(BWSUBH) D @BWSUBH
  1.  Q
  1.  ;
  1.  ;
  1. HEADER4 ;EP
  1.  ;---> PATIENT REPORT HEADER: ONE PATIENT, ONE PROCEDURE.
  1.  ;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE1,DUZ(2)
  1.  ;---> OPTIONAL VARIABLE:  BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
  1.  W:BWPAGE>1!BWCRT @IOF,!
  1.  W BWCONFF W:'BWCRT !,BWTIMLN
  1.  W !!,BWTITLE1,?70,"page: ",BWPAGE S BWPAGE=BWPAGE+1
  1. HEADER41 ;EP
  1.  ;---> CALLED BY BWPROC; BYPASSES FORMFEED, TITLE, ETC.
  1.  W !!,"Patient Name: ",BWNAMAGE,?53,$$PNLAB^BWUTL5(DUZ(2)),BWCHRT
  1.  W !,"Case Manager: ",BWCMGR
  1.  W ?50,"Procedure: ",$E(BWPN,1,19)
  1.  W !,"Cx Tx Need  : ",BWCNEED
  1.  W ?55,"Acc#: ",BWACCN
  1.  W !,"PAP Regimen : ",BWPAPRG
  1.  W !,"Br Tx Need  : ",BWBNEED
  1.  W ?61,$S($$DES^BWUTL1(BWDFN):"*DES DAUGHTER*",1:"")
  1.  W ! F I=1:1:49 W "-"
  1.  W $S(BWEDC]"":BWEDC_"------",1:"-------------------------------")
  1.  Q
  1.  ;
  1.  ;
  1. HEADER5 ;EP
  1.  ;---> DELINQUENT NEEDS REPORT HEADER: MULTIPLE PATIENTS
  1.  ;---> REQUIRED VARIABLES: BWBEGDT,BWCRT,BWENDDT,BWPAGE,BWTITLE,DUZ(2)
  1.  ;---> OPTIONAL VARIABLE:  BWCONF (CONFIDENTIAL), BWSUBH (SUBHEADER).
  1.  N X
  1.  W:BWPAGE>1!BWCRT @IOF,!
  1.  W:$D(BWCONF) BWCONFF,! W:'BWCRT BWTIMLN,!
  1.  W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE
  1.  W !!,"Case Mgr: " D
  1.  .I '$D(BWE) W "ALL" Q
  1.  .I BWE W "ALL" Q
  1.  .I $G(BWCMGR)']"" W "UNKNOWN" Q
  1.  .I '$D(^VA(200,BWCMGR,0)) W "UNKNOWN" Q
  1.  .W $P(^VA(200,BWCMGR,0),U)
  1.  W ?46,"Communit" D
  1.  .I $D(BWCC("ALL")) W "ies: ALL" Q
  1.  .N I,N S N=0 F I=0:1 S N=$O(BWCC(N)) Q:'N
  1.  .I I=1 W "y: ",$E($P(^AUTTCOM($O(BWCC(N)),0),U),1,22) Q
  1.  .W "ies: ",$E($P(^AUTTCOM($O(BWCC(N)),0),U),1,18),",..." Q
  1.  W !,"Facility: ",$$INSTTX^BWUTL6(BWFAC)
  1.  W ?46,"Tx Needs Past Due as of ",$$SLDT2^BWUTL5(BWDDATE)
  1.  W ! F I=1:1:80 W "="
  1.  I $D(BWSUBH) D @BWSUBH
  1.  Q
  1.  ;
  1.  ;
  1. HEADER6 ;EP
  1.  ;---> PROGRAM SNAPSHOT HEADER: JUST TITLE AND FACILITY (NO PATIENTS)
  1.  ;---> REQUIRED VARIABLES: BWCRT,BWTITLE,DUZ(2)
  1.  N X
  1.  W:BWPAGE>1!BWCRT @IOF,!
  1.  W:'BWCRT !,BWTIMLN,!
  1.  W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE
  1.  W !!,"   Note: This report includes all facilities"
  1.  W " using this database."
  1.  ;W " Facility: ",$$INSTTX^BWUTL6(DUZ(2))
  1.  ;W " (This report is not site specific.)"
  1.  W ! F I=1:1:80 W "="
  1.  Q
  1.  ;
  1.  ;
  1. HEADER7 ;EP
  1.  ;---> AUTOLOAD OF PATIENTS HEADER
  1.  ;---> REQUIRED VARIABLES: BWCRT,BWTITLE,DUZ(2)
  1.  N X
  1.  W:BWPAGE>1!BWCRT @IOF,!
  1.  W:$D(BWCONF) BWCONFF,! W:'BWCRT BWTIMLN,!
  1.  W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE S BWPAGE=BWPAGE+1
  1.  W !!,"Facility: ",$$INSTTX^BWUTL6(DUZ(2))
  1.  W ?64,"Cutoff Age: ",BWAGE
  1.  W ! F I=1:1:80 W "="
  1.  W !,?3,"NAME",?30,$$PNLB^BWUTL5(DUZ(2)),?45,"DOB",?60,"STATUS"
  1.  W !,BWLINE
  1.  Q
  1.  ;
  1.  ;
  1. HEADER8 ;EP
  1.  ;---> SCREENING RATES REPORT HEADER: (NO PATIENTS)
  1.  ;---> REQUIRED VARIABLES: BWCRT,BWTITLE,DUZ(2)
  1.  N X
  1.  W:BWPAGE>1!BWCRT @IOF,!
  1.  W:'BWCRT !,BWTIMLN,!
  1.  W !,BWTITLE W:'BWCRT ?70,"page: ",BWPAGE
  1.  W !!?4,"For Age Range: ",$S(BWAGRG=1:"ALL",1:BWAGRG)
  1.  W ?56,"For period: ",$$SLDT2^BWUTL5(BWBEGDT)
  1.  W !?4,"Communit" D
  1.  .I $D(BWCC("ALL")) W "ies: ALL" Q
  1.  .N I,N S N="",I=0 F  S N=$O(BWCC(N)) Q:N=""  S I=I+1
  1.  .I I=1 W "y: ",$E($O(BWCC("")),1,22) Q
  1.  .W "ies: ",$E($O(BWCC("")),1,18),",..." Q
  1.  W ?64,"To: ",$$SLDT2^BWUTL5(BWENDDT)
  1.  W ! F I=1:1:80 W "="
  1.  W !?4,"(Note: This report includes all facilities"
  1.  W " using this database.)",!
  1.  ;I $D(BWSUBH) D @BWSUBH
  1.  Q
  1.  ;
  1. ENDREP(X) ;EP
  1.  ;---> END A REPORT, DO FORMFEED OR "Press <Return>" IF NECESSARY.
  1.  ;---> REQUIRED VARIABLES: BWCRT=1 IF OUTPUT TO SCREEN
  1.  ;--->                     BWPOP=1 IF ESCAPING
  1.  ;---> OPTIONAL VARIABLE:  X=1 IF "End of Report" SHOULD NOT DISPLAY.
  1.  ;
  1.  S BWTITLE="-----  End of Report  -----"
  1.  I '$G(X)&('BWPOP) D CENTERT^BWUTL5(.BWTITLE) W !,BWTITLE
  1.  W:'BWCRT @IOF,!
  1.  I BWCRT&('$D(IO("S")))&('BWPOP) D DIRZ^BWUTL3 W @IOF,!
  1.  D ^%ZISC
  1.  Q