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

BWMPMAIN.m

Go to the documentation of this file. 
  1. BWMPMAIN ;IHS/CIA/PLS - Main driver for Mammography Project Add/Edit ;01-Oct-2003 16:55;PLS
  1.  ;;2.0;WOMEN'S HEALTH;**9**;04-Apr-2003 11:31
  1.  ;=================================================================
  1. EN D EN1
  1.  Q
  1.  ; Main loop
  1. EN1 ;
  1.  N X,BWQUIT
  1.  F  Q:$$PATSEL=-1
  1.  Q
  1. PATSEL() ;
  1.  D TITLE^BWUTL5("Add/Edit Mammography Project Data")
  1.  ; PATSEL1() ;
  1.  N Y,BWDFN
  1.  W !!,"  Select the patient you wish to add or edit."
  1.  D PATLKUP^BWUTL8(.Y,"ADD")
  1.  Q:Y<0 -1
  1.  S BWDFN=+Y
  1.  D CDCID(BWDFN)
  1.  D ADDEDIT
  1.  Q 0
  1.  ;
  1. ADDEDIT ;
  1.  N DIR
  1.  S DIR(0)="SO^1:Add New Procedure;2:Edit Existing Procedure"
  1.  S DIR("A")="Which function"
  1.  W !
  1.  D ^DIR
  1.  I Y=1 D
  1.  .D ADD
  1.  E  I Y=2 D
  1.  .D LOOKUP
  1.  Q
  1. ADD ; Add a procedure
  1.  N DRSTR,BWPCDDA
  1.  S BWPCDN=$O(^BWPN("B","MAMMOGRAPHY PROJECT",0))
  1.  I 'BWPCDN D  Q
  1.  .W !,"The MAMMOGRAPHY PROJECT procedure is missing."
  1.  .W !,"Contact the computer department."
  1.  I BWPCDN&($$GET1^DIQ(9002086.2,BWPCDN,.18,"I")=1) D  Q
  1.  .I  D
  1.  ..W !,"The MAMMOGRAPHY PROJECT procedure is INACTIVE."
  1.  ..W !,"Contact the site manager."
  1.  ..S BWQUIT=1
  1.  D DATECHK^BWPROC Q:BWPOP
  1.  S BWACC=$$ACCSSN^BWUTL5(BWPCDN)
  1.  I BWACC']"" D  Q
  1.  .W !!?5,*7,"Unable to generate accession number. Contact your site manager."
  1.  .S ERROR=-1 D DIRZ^BWUTL3
  1.  S DRSTR=".02////"_BWDFN_";.03////"_BWPCDT_";.04////"_BWPCDN_";.1////"_$G(DUZ(2))_";.12////"_BWPCDT_";.18////"_DUZ_";.19///"_$$DT^XLFDT_";.34////"_$G(DUZ(2))
  1.  D FILE^BWFMAN(9002086.1,DRSTR,"ML",BWACC,9002086,.BWPCDDA)
  1.  I BWPCDDA=-1 D  Q
  1.  .W !!?5,*7,"Unable to create new procedure. Contact your site manager."
  1.  .S ERROR=-1 D DIRZ^BWUTL3
  1.  ;
  1. EDIT D SCREEN(+BWPCDDA)
  1.  Q
  1.  ; Call ScreenMan interface engine
  1. SCREEN(BWPCDDA) ;
  1.  N DR
  1.  S DR="[BW MP MAIN]"
  1.  D DDS^BWFMAN(9002086.1,DR,BWPCDDA,"","",.BWQUIT)
  1.  Q
  1. LOOKUP ; Lookup existing Mammography Project procedure
  1.  N BWX,FLG
  1.  N D,DIC,Y,X
  1.  S (BWX,FLG)=0
  1.  F  S BWX=$O(^BWPCD("C",BWDFN,BWX)) Q:'BWX!FLG  D
  1.  .S:+$P($G(^BWPCD(BWX,0)),U,4)=44 FLG=1
  1.  I 'FLG D  Q
  1.  .;W !,$$GET1^DIQ(2,BWDFN,.01,"E")," is not enrolled in the Mammography Project."
  1.  .;W !,"She will now be enrolled."
  1.  .D ADD
  1.  E  D  Q
  1.  .S D="C",DIC="^BWPCD(",DIC(0)="EQZ"
  1.  .S X=BWDFN,DIC("S")="I $P(^(0),U,4)=44"
  1.  .D IX^DIC
  1.  .D:Y>0 SCREEN(+Y)
  1.  Q
  1.  ; Assign a CDCID # to this patient
  1. CDCID(BWDFN) ;
  1.  N X
  1.  S X=$$CDCID^BWUTL5(BWDFN,DUZ(2))
  1.  Q:X']""
  1.  D DIE^BWFMAN(9002086,".2////"_X,BWDFN,.BWPOP)
  1.  Q
  1.  ;
  1. HELP Q