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

BWPROF.m

Go to the documentation of this file. 
  1. BWPROF ;IHS/ANMC/MWR - DISPLAY PATIENT PROFILE; [ 09/17/2001  7:55 AM ]
  1.  ;;2.0;WOMEN'S HEALTH;**1,6,8**;MAY 16, 1996
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  CALL ED BY OPTION: "BW PATIENT PROFILE" TO DISPLAY PROFILE.
  1.  ;;  PATCHED AT LINELABEL PROFCALL.  IHS/ANMC/MWR 11/20/96
  1.  ;
  1.  ;---> *NOTE: TO ASK DATE RANGE, UNCOMMENT ALL LINES WITH "XDATES",
  1.  ;--->        AND IN HEADER2^BWUTL7.
  1.  ;
  1.  ;---> VARIABLES:
  1.  ;---> BWDFN: DFN OF SELECTED PATIENT
  1.  ;---> DATES: BWBEGDT=BEGINNING DATE, BWENDDT=ENDING DATE
  1.  ;---> USE NODES 1 & 2 IN ^TMP GLOBAL.
  1.  ;
  1.  D SETVARS^BWUTL5
  1.  S:'$D(BWERRORS) BWERRORS=1
  1.  F  D RUN Q:BWPOP
  1.  D EXIT
  1.  Q
  1.  ;
  1. RUN ;EP
  1.  D TITLE^BWUTL5("PATIENT PROFILE")
  1.  D PATIENT Q:BWPOP
  1.  ;D DATES  Q:BWPOP
  1.  D BRIEF   Q:BWPOP
  1.  D DEVICE  Q:BWPOP
  1.  D SORT^BWPROF2
  1.  D COPYGBL
  1.  D ^BWPROF1 S BWPOP=0
  1.  K BWD,BWSUBH
  1.  Q
  1.  ;
  1. EXIT ;EP
  1.  D KILLALL^BWUTL8
  1.  Q
  1.  ;
  1.  ;
  1. PATIENT ;EP
  1.  ;---> SELECT PATIENT (RETURN BWDFN).
  1.  W !!,"   Select the patient whose Profile you wish to display."
  1.  D PATLKUP^BWUTL8(.Y) S:Y<0 BWPOP=1
  1.  ;---> USE NEXT LINE IF I WANT TO ADD CAPABILITY OF ADDING NEW PATIENT.
  1.  ;D PATLKUP^BWUTL8(.Y,$S($G(BWPUSER):"",1:"ADD")) S:Y<0 BWPOP=1
  1.  S BWDFN=+Y
  1.  Q
  1.  ;
  1. DATES ;EP
  1.  ;---> ASK DATE RANGE.  RETURN DATES IN BWBEGDT AND BWENDDT.
  1.  ;---> IF LOOKING AT ONLY ONE PATIENT, SET DEFAULT BEGIN DATE=T-5YEARS.
  1.  ;S BWBEGDT=2500101,BWENDDT=DT     ;---> XDATES-CAN USE THIS INSTEAD.
  1.  ;S BWBEGDF="T-60M",BWENDDF="T"    ;---> XDATES
  1.  ;D ASKDATES^BWUTL3(.BWBEGDT,.BWENDDT,.BWPOP,"T-365","T")  ;---> XDATES
  1.  Q
  1.  ;
  1. BRIEF ;EP
  1.  ;---> BRIEF OR DETAILED LISTING OF PROCEDURES (BRIEF DOES NOT LIST
  1.  ;---> NOTIFICATIONS AND PROVIDERS).
  1.  N DIR,DIRUT,Y
  1.  W !!?3,"List Patient Profile in BRIEF or DETAILED format?"
  1.  S DIR("A")="   Select BRIEF or DETAILED: ",DIR("B")="BRIEF"
  1.  S DIR(0)="SAM^b:BRIEF;d:DETAILED" D HELP1
  1.  D ^DIR
  1.  I Y=-1!($D(DIRUT)) S BWPOP=1 Q
  1.  ;---> IF ALL DETAILED, S BWD=1; FOR BRIEF BWD=0
  1.  S BWD=$S(Y="d":1,1:0)
  1.  Q
  1.  ;
  1. DEVICE ;EP
  1.  ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
  1.  S ZTRTN="DEQUEUE^BWPROF"
  1.  F BWSV="D","DFN","BEGDT","ENDDT","ERRORS" D
  1.  .I $D(@("BW"_BWSV)) S ZTSAVE("BW"_BWSV)=""
  1.  D ZIS^BWUTL2(.BWPOP,1,"HOME")
  1.  Q
  1.  ;
  1. COPYGBL ;EP
  1.  ;---> COPY ^TMP("BW",$J,1 TO ^TMP("BW",$J,2 TO MAKE IT FLAT.
  1.  N I,M,N,P,Q
  1.  S N=0,I=0
  1.  F  S N=$O(^TMP("BW",$J,1,N)) Q:N=""  D
  1.  .S M=0
  1.  .F  S M=$O(^TMP("BW",$J,1,N,M)) Q:M=""  D
  1.  ..S P=0
  1.  ..F  S P=$O(^TMP("BW",$J,1,N,M,P)) Q:P=""  D
  1.  ...S Q=0
  1.  ...F  S Q=$O(^TMP("BW",$J,1,N,M,P,Q)) Q:Q=""  D
  1.  ....S I=I+1,^TMP("BW",$J,2,I)=^TMP("BW",$J,1,N,M,P,Q)
  1.  Q
  1.  ;
  1.  ;
  1. DEQUEUE ;EP
  1.  ;---> EP FOR TASKMAN QUEUE OF PRINTOUT.
  1.  D SETVARS^BWUTL5,SORT^BWPROF2,COPYGBL,^BWPROF1,EXIT
  1.  Q
  1.  ;
  1. HELP1 ;EP
  1.  ;;Enter "D" for a "Detailed" listing of the patient's Procedures,
  1.  ;;Notifications, PAP Regimen and Pregnancy changes.
  1.  ;;Enter "B" for a "Brief" listing of the patient's Procedures only.
  1.  S BWTAB=5,BWLINL="HELP1" D HELPTX
  1.  Q
  1.  ;
  1. HELPTX ;EP
  1.  ;---> CREATES DIR ARRAY FOR DIR.  REQUIRED VARIABLES: BWTAB,BWLINL.
  1.  N I,T,X S T="" F I=1:1:BWTAB S T=T_" "
  1.  F I=1:1 S X=$T(@BWLINL+I) Q:X'[";;"  S DIR("?",I)=T_$P(X,";;",2)
  1.  S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
  1.  Q
  1.  ;
  1.  ;
  1. USER ;EP
  1.  ;---> CALLED BY OPTION: "BW PATIENT PROFILE USER"
  1.  ;---> FOR USER TO VIEW PROFILE AND PRINT PROCEDURES, BUT NO EDIT.
  1.  S BWPUSER=1
  1.  D BWPROF K BWPUSER
  1.  Q
  1.  ;
  1. PROFCALL(BWDFN) ;EP
  1.  ;---> PATCHED: EARLIER METHODS FOR OTHER PACKAGES TO PRODUCE A
  1.  ;---> WOMEN'S HEALTH PROFILE WERE TO CUMBERSOME AND ERROR PRONE.
  1.  ;---> USED TO CALL A PATIENT PROFILE (DISPLAY ONLY) WITH PATIENT
  1.  ;---> ALREADY SELECTED.  DFN PASSED AS FIRST PARAMETER.
  1.  ;---> THIS ENTIRE CALL HAS BEEN ADDED AS A PATCH. IHS/ANMC/MWR 11/20/96
  1.  I '$G(BWDFN) D  Q
  1.  .W !?5,"Patient DFN was not passed.  Please contact your site manager."
  1.  .D DIRZ^BWUTL3
  1.  I '$D(^BWP(BWDFN,0)) D  Q
  1.  .W !?5,"This patient is not currently in the Women's Health Database."
  1.  .D DIRZ^BWUTL3
  1.  N (BWDFN)
  1.  D SETVARS^BWUTL5 S BWERRORS=1,BWPUSER=1
  1.  D BRIEF  Q:BWPOP
  1.  D DEVICE Q:BWPOP
  1.  D SORT^BWPROF2
  1.  D COPYGBL
  1.  D ^BWPROF1
  1.  Q
  1.  ;
  1. ERRORS ;EP
  1.  ;---> CALLED BY OPTION: "BW PATIENT PROFILE W/ERRORS"
  1.  ;---> ENTER HERE TO INCLUDE ERRONEOUS ENTRIES.
  1.  S BWERRORS=0 G BWPROF
  1.  Q
  1.  ;
  1. EP(BWDFN,BWD,BWEXT) ;PEP called without user interaction to display profile
  1.  ;IHS/CMI/LAB - patch 6 added this subroutine this is
  1.  ;called from the health summary.
  1.  ;---> PATCHED: EARLIER METHODS FOR OTHER PACKAGES TO PRODUCE A
  1.  ;---> WOMEN'S HEALTH PROFILE WERE TO CUMBERSOME AND ERROR PRONE.
  1.  ;---> USED TO CALL A PATIENT PROFILE (DISPLAY ONLY) WITH PATIENT
  1.  ;---> ALREADY SELECTED.  DFN PASSED AS FIRST PARAMETER.
  1.  ;---> THIS ENTIRE CALL HAS BEEN ADDED AS A PATCH. IHS/ANMC/MWR 11/20/96
  1.  ;IHS/CMI/THL PATCH 8 BWEXT SET FOR EXTERNAL CALL SO DEVICE ISN'T CLOSED
  1.  Q:'$G(BWDFN)
  1.  Q:$G(BWD)=""  ;did not pass brief/detailed
  1.  Q:'$D(^BWP(BWDFN,0))
  1.  D EN^XBNEW("EP1^BWPROF","BWDFN;BWD")
  1.  Q
  1. EP1 ;EP called by xbnew
  1.  D SETVARS^BWUTL5 S BWERRORS=1,BWPUSER=1
  1.  D SORT^BWPROF2
  1.  D COPYGBL
  1.  D ^BWPROF1
  1.  Q