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

BWPATE.m

Go to the documentation of this file. 
  1. BWPATE ;IHS/ANMC/MWR/CIA/PLS -  PATIENT CASE DATA EDIT;23-Jan-2009 10:35;DU
  1.  ;;2.0;WOMEN'S HEALTH;**8,9,11,13**;APR 19, 1996;Build 9
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  CALLED BY OPTION: "BW EDIT PATIENT CASE DATA".
  1.  ;
  1.  D SETVARS^BWUTL5
  1.  F  D PATIENT Q:BWPOP
  1.  ;
  1. EXIT ;EP
  1.  D KILLALL^BWUTL8
  1.  Q
  1.  ;
  1.  ;
  1. PATIENT ;EP
  1.  D TITLE^BWUTL5("EDIT PATIENT CASE DATA")
  1. PATIENT1 ;EP
  1.  ;---> TO AVOID @IOF AND TITLE.
  1.  ;---> SELECT PATIENT.
  1.  N Y
  1.  W !!,"   Select the patient you wish to add or edit."
  1.  D PATLKUP^BWUTL8(.Y,"ADD")
  1.  I Y<0 S BWPOP=1 Q
  1.  S BWDFN=+Y
  1.  D CDCID(BWDFN)
  1.  D SCREEN(BWDFN) S BWPOP=0
  1.  Q
  1.  ;
  1.  ;
  1. SCREEN(BWDFN) ;EP
  1.  ;---> EDIT PATIENT CASE DATA WITH SCREENMAN.
  1.  ;---> REQUIRED VARIABLES: BWDFN=DFN OF PATIENT.
  1.  N DR
  1.  S DR="[BW PATIENT-FORM-1]"
  1.  D DDS^BWFMAN(9002086,DR,BWDFN,"","",.BWPOP)
  1.  Q:BWPOP
  1.  N DIR W !,"Do you wish to PRINT this patient's Case Data?"
  1.  S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR W !
  1.  D:Y PRTCASE^BWPATP(BWDFN)
  1.  Q
  1.  ;
  1. CASEDATA(BWDFN) ;EP
  1.  ;---> CALLED AFTER ADD/EDIT OF NOTIFICATIONS.
  1.  N DIR W !,"Do you wish to EDIT this patient's Case Data?"
  1.  S DIR("?",1)="   Enter YES to edit this patient's Case Manager, "
  1.  S DIR("?")="   PAP Regimen, Current Need, etc."
  1.  S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR W !
  1.  D:Y SCREEN(BWDFN)
  1.  Q
  1.  ;
  1. AUTOADD(DFN,SITE,Y,BWPRMT) ;EP
  1.  ;---> AUTOMATIC ADD OF A NEW PATIENT TO "BW PATIENT FILE".
  1.  ;---> SET CASEMANAGER TO SITE PARAMETER DEFAULT.
  1.  ;---> SET PAP TX NEED (#.11), PAP REGIMEN (#.16)="Undetermined",
  1.  ;---> MAM TX NEED (#.18)="Undetermined".
  1.  ;---> Set RACE of patient via tribal affiliation
  1.  ;---> PARAMETERS:
  1.  ;     1 - DFN     (REQUIRED) IEN OF PATIENT IN ^AUPNPAT(
  1.  ;     2 - SITE    (REQUIRED) DUZ(2) FOR DEFAULT CASE MANAGER
  1.  ;     3 - Y       (RETURNED) FROM ^DICN: IEN OR -1 FAILURE TO ADD PT
  1.  ;     4 - BWPRMT  (OPTIONAL) EQUALS 1 IF PROMPT WHEN FAILURE
  1.  ;
  1.  S (DINUM,X)=DFN
  1.  ;---> SET CASE MANAGER DEFAULT.
  1.  N BWCMGR,DIC
  1.  S BWCMGR=$S($D(SITE):$P(^BWSITE(SITE,0),U,2),1:"")
  1.  S:'$G(BWPRMT) BWPRMT=0
  1.  ;S DIC("DR")=".1////"_BWCMGR_";.11///Undetermined;.16///Undetermined"
  1.  ;S DIC("DR")=DIC("DR")_";.18///Undetermined"
  1.  ;S DIC("DR")=DIC("DR")_";.2////"_$$CDCID^BWUTL5(DFN,SITE)_";.21////"_DT
  1.  K DD,DO S DIC="^BWP(",DIC(0)="ML",DLAYGO=9002086
  1.  D FILE^DICN K DIC
  1.  ;---> IF Y<0, CHECK PERMISSIONS.
  1.  I Y<0,BWPRMT D  Q
  1.  .W !!?5,"* UNABLE to add this patient to the Women's Health database."
  1.  .W !?5,"  Please contact your site manager to check permissions."
  1.  .D DIRZ^BWUTL3
  1.  S Y=+Y
  1.  S BWUP(9002086,Y_",",.1)=BWCMGR,BWUP(9002086,Y_",",.11)="Undetermined"
  1.  S BWUP(9002086,Y_",",.16)="Undetermined",BWUP(9002086,Y_",",.18)="Undetermined"
  1.  S BWUP(9002086,Y_",",.2)=$$CDCID^BWUTL5(DFN,SITE),BWUP(9002086,Y_",",.21)=DT
  1.  D FILE^DIE("","BWUP","ERROR")
  1.  D ADDRACE(DFN,Y)
  1.  Q
  1.  ;
  1. CDCID(BWDFN) ;EP
  1.  ;---> ASSIGN A CDCID# TO THIS PATIENT.
  1.  N X S X=$$CDCID^BWUTL5(BWDFN,DUZ(2))
  1.  Q:X']""
  1.  D DIE^BWFMAN(9002086,".2////"_X,BWDFN,.BWPOP)
  1.  Q
  1.  ;
  1. CDCEDIT ;EP
  1.  ;---> EDIT A PATIENT'S CDC ID NUMBER.
  1.  D SETVARS^BWUTL5
  1.  N Y
  1.  F  D  Q:$G(Y)<0
  1.  .D TITLE^BWUTL5("EDIT A PATIENT'S CDC ID NUMBER")
  1.  .D PATLKUP^BWUTL8(.Y)
  1.  .Q:Y<0
  1.  .D DIE^BWFMAN(9002086,.2,+Y,.BWPOP)
  1.  .S:BWPOP Y=-1
  1.  Q
  1.  ; Return Previous Procedure Date of type passed or None
  1. PREVPROC(BWPROC,BWDFN,BWDT) ;
  1.  N X
  1.  S BWDT=$G(BWDT,DT)
  1.  S X=$G(^BWPCD($$FINDLAST^BWMDEX2(BWPROC,BWDT,0),0))
  1.  Q $S($P(X,U,12):$$FMTE^XLFDT($P(X,U,12)),1:"None")  ;"5Z"
  1.  ; Add Race associated with tribal affiliation
  1.  ;     (defaults to American Indian
  1. ADDRACE(BWDFN,IEN) ;
  1.  N BWIENS,BWFDA,BWERR,BWRC
  1.  S IENS="+1,"_IEN_","
  1.  S BWRC=$$GET1^DIQ(9000001,BWDFN,1108,"I")
  1.  S BWRC=+$O(^BWRACE("C",BWRC,0))
  1.  S:'BWRC BWRC=""
  1.  S BWFDA(9002086.07,IENS,.001)=1
  1.  S BWFDA(9002086.07,IENS,.01)=BWRC
  1.  D UPDATE^DIE("","BWFDA","","BWERR")
  1.  Q
  1.  ; Screen on Race Field in BW PATIENT File
  1.  ; Returns availability of race entry for selection
  1. RACESEL(IEN) ;
  1.  N MDEVER
  1.  S MDEVER=+$$GET1^DIQ(9002086.02,+$G(DUZ(2)),.18,"I")
  1.  Q +$O(^BWRACE(IEN,1,"AC",MDEVER,0))>0