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

BWPROC1.m

Go to the documentation of this file. 
  1. BWPROC1 ;IHS/ANMC/MWR - BW ADD/EDIT BW PROCEDURE;25-Feb-2011 17:08;PLS
  1.  ;;2.0;WOMEN'S HEALTH;**7,8,9,11**;MAY 16, 1996
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  EDIT A PROCEDURE, ALSO FOLLOW-UP SCREEN.  CALLED BY BWPROC.
  1.  ;
  1.  ;
  1. EDIT2(DA,BWPOP) ;EP
  1.  ;---> EDIT A PROCEDURE.
  1.  ;---> REQUIRED VARIABLES: DA=IEN IN ^BWPCD(.
  1.  S BWPOP=0
  1.  I '$G(DA) D  D OUT^BWUTL3 Q
  1.  .W !,"NO PROCEDURE (DA).  PLEASE CONTACT YOUR SITE MANAGER."
  1.  I '$D(^BWPCD(DA,0)) D  D OUT^BWUTL3 Q
  1.  .W !,"^BWPCD NOT DEFINED.  PLEASE CONTACT YOUR SITE MANAGER."
  1.  S (AUPNPAT,BWDFN)=$P(^BWPCD(DA,0),U,2)
  1.  D SCREEN(DA,.BWPOP)
  1.  ;---> IF ENTRY WAS LOCKED, BWPOP=1.
  1.  Q:BWPOP
  1.  ;
  1.  ;---> NEXT LINES ARE PURELY FOR CDC PURPOSES: IF THIS PROC IS A CBE,
  1.  ;---> AND IF IT WAS STORED UNDER A PAP, UPDATE THE PAP CBE FIELDS.
  1.  I $P(^BWPCD(DA,0),U,4)=27,$$CDC^BWUTL5(DUZ(2)) D
  1.  .;---> QUIT IF NOT STORED UNDER A PAP.
  1.  .Q:'$D(^BWPCD(DA,2))  Q:'$P(^BWPCD(DA,2),U,36)
  1.  .;---> GO UPDATE THE PAP POINTED TO BY FIELD #2.36 OF THIS CBE.
  1.  .D ADDCBE1^BWPROC(DA,$P(^BWPCD(DA,2),U,36))
  1.  Q
  1.  ;
  1.  ;
  1. SCREEN(DA,BWPOP) ;EP
  1.  ;---> EDIT A PROCEDURE WITH SCREENMAN.
  1.  ;---> REQUIRED VARIABLES: DA=IEN IN PROCEDURE FILE.
  1.  ;---> STORE OLD ZERO NODE VALUES IN BWOLD TO COMPARE FOR EDITS,
  1.  ;---> STORE OLD 2 NODE VALUES IN BWOLD2.  IF ZERO NODE HAS CHANGED
  1.  ;---> RE-EXPORT TO PCC; IF ZERO OR 2 NODE CHANGED, FLAG FOR CDC.
  1.  ;
  1.  N BWOLD,BWOLD2,BWPCDN,DDSFILE,DR,Y
  1.  S DDSFILE=9002086.1
  1.  S BWOLD=^BWPCD(DA,0) S:$D(^(2)) BWOLD2=^BWPCD(DA,2)
  1.  ;---> BWCDC=1 IF THIS PROCEDURE SHOULD BE EXPORTED TO CDC.
  1.  S BWPCDN=$P(BWOLD,U,4),BWCDC=$$CDCEXP^BWUTL5(BWPCDN,DUZ(2))
  1.  ;
  1.  ;---> SET DR=TO THE APPROPRIATE FORM.
  1.  D
  1.  .;---> IF THIS IS A COLPOSCOPY-TYPE PROCEDURE, USE FORM-2.
  1.  .I $$COLP^BWUTL4(DA) S DR="[BW PROC-FORM-2-COLP]" Q
  1.  .;
  1.  .;---> IF THIS SITE COLLECTS CDC DATA AND THIS IS A PROCEDURE THAT
  1.  .;---> SHOULD BE EXPORTED (PAP OR MAM) USE FORM-3-CDC-PAP/MAM.
  1.  .I BWCDC!(BWPCDN>24&(BWPCDN<27)) S DR="[BW PROC-FORM-3-CDC-"_$S(BWPCDN=1:"PAP]",1:"MAM]") Q  ;IHS/CMI/THL PATCH 8
  1.  .;---> OTHERWISE, USE FORM 1 (ONLY PAGE 1).
  1.  .I BWPCDN>29,BWPCDN<36 S DR="[BW PROC-FORM-P2]" Q  ;IHS/CMI/THL PATCH 7
  1.  .I BWPCDN=27 S DR="[BW PROC-FORM-1-CBE]" Q
  1.  .I BWPCDN=40 S DR="[BW PROC-FORM-1-HPV]"
  1.  .E  S DR="[BW PROC-FORM-1]" ;IHS/CMI/THL PATCH 7
  1.  ;
  1.  ;---> CALL SCREENMAN.
  1.  D DDS^BWFMAN(DDSFILE,DR,DA,"","",.BWPOP)
  1.  Q:BWPOP
  1.  ;
  1. PCC ;---> PCC EXPORT.
  1.  ;---> QUIT IF THIS IS NOT AN IHS SITE; NO PCC AND NO CDC.
  1.  Q:$$AGENCY^BWUTL5(DUZ(2))'="i"  ;VAMOD
  1.  Q:'$D(DA)  Q:'$D(^BWPCD(DA,0))
  1.  S BWDA=DA,Y=^BWPCD(DA,0) D
  1.  .N DA
  1.  .I '$D(^BWPCD(BWDA,"PCC")) D CREATE^BWPCC(BWDA,DUZ(2),Y) Q
  1.  .I BWOLD'=Y D EDIT^BWPCC(BWDA,DUZ(2),Y,^BWPCD(BWDA,"PCC")) Q
  1.  ;
  1.  ;
  1. CDC ;---> CDC EXPORT.
  1.  ;---> * !NOT CURRENTLY USED.  SAVE IN CASE IMS SWITCHES BACK.
  1.  ;--->    FOR NOW THEY WANT ALL PROCEDURES EXPORTED EACH TIME.
  1.  Q
  1.  S Y=^BWPCD(DA,0)
  1.  ;---> IF PROCEDURE WAS EDITED, THEN CHECK TO FLAG FOR CDC EXPORT.
  1.  I BWOLD'=Y!($S($D(BWOLD2):BWOLD2'=^BWPCD(DA,2),1:0)) D
  1.  .;---> QUIT IF PROCEDURE IS ALREADY MARKED FOR EXPORT.
  1.  .Q:$P(Y,U,17)
  1.  .;---> QUIT IF PROCEDURE RESULT IS ERROR/DISREGARD.
  1.  .Q:$P(Y,U,5)=8
  1.  .;---> QUIT IF SITE NOT EXPORTING OR IF PCD SHOULDN'T BE EXPORTED.
  1.  .Q:'BWCDC
  1.  .;---> FLAG PROCEDURE FOR EXPORT AS AN "UPDATE".
  1.  .D DIE^BWFMAN(9002086.1,".17///2",DA,.BWPOP,1)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. FOLLOWUP(BWDA) ;EP
  1.  ;---> PROCEDURE FOLLOW-UP MENU.
  1.  ;---> REQUIRED VARIABLES: BWDA=IEN IN PROCEDURE FILE.
  1.  ;---> BWLOOP TELLS BWNOTIF (ADD NEW NOTIFICATION) NOT TO OFFER TO EDIT
  1.  ;---> CASE DATA, SINCE THAT OPTION IS ALREADY OFFERED IN THIS LOOP.
  1.  S BWLOOP=1 N BWPOP,BWPOP1,DIR,DIRUT,Y
  1.  F  Q:$D(DIRUT)  D
  1.  .S BWTITLE="*  PROCEDURE FOLLOW-UP MENU  *" D CENTERT^BWUTL5(.BWTITLE)
  1.  .W @IOF,!!,BWTITLE
  1.  .;---> PCDVARS (BELOW) PROVIDES: BWACCN,BWDFN,BWPCDN,BWRESN
  1.  .D PCDVARS^BWUTL3(DA,1),HEADER41^BWUTL7
  1.  .S DIR("A")="   Select A, C, E, P, or <return>: "
  1.  .S DIR(0)="SMOA^a:ADD;c:CLOSE;e:EDIT;p:PRINT"
  1.  .W !!?3,"To take a Follow-up action on this procedure, choose:"
  1.  .W !!?5,"A to ADD a NEW Notification for this patient,"
  1.  .W !?5,"C to review and CLOSE any Open Notifications for this patient,"
  1.  .W !?5,"E to EDIT this Patient's Case Data,"
  1.  .W !?5,"P to PRINT all of the information for this Procedure,"
  1.  .D FACE,NORMAL,CBE
  1.  .W !?5,"or press <return> to continue.",!
  1.  .D ^DIR K DIR
  1.  .Q:$D(DIRUT)
  1.  .I Y="a" D NEW^BWNOTIF(BWDFN,BWACCN) Q
  1.  .I Y="c" D FOLLOW^BWBRNOT(BWDFN) Q
  1.  .I Y="e" D SCREEN^BWPATE(BWDFN) Q
  1.  .I Y="p" D TOP^BWPRPCD(BWDA) Q
  1.  .I Y="f" D FOLLUP^BWFACE(BWDFN) Q
  1.  .I Y="q" D NORMALL^BWNOTIF1(BWDFN,BWACCN,BWSPEC,BWSPTX) Q
  1.  .I Y="b" D ADDCBE^BWPROC(BWDFN,BWDA) Q
  1.  W @IOF
  1.  Q
  1.  ;
  1. FACE ;EP
  1.  ;---> PRINT A FACE SHEET FOR THIS PATIENT.
  1.  W !?5,"F to display/print this Patient's FACE SHEET,"
  1.  S DIR("A")=$P(DIR("A"),"or")_"F, or <return>: "
  1.  S DIR(0)=DIR(0)_";f:FACE"
  1.  Q
  1.  ;
  1. NORMAL ;EP
  1.  ;---> IF RESULT IS NORMAL, ADD OPTION TO QUEUE NORMAL PAP/MAM LETTER.
  1.  ;---> QUIT IF VARIABLES NOT ADEQUATE.
  1.  N X
  1.  Q:'$G(BWPCDN)!('$G(BWRESN))!('$D(BWACCN))
  1.  ;
  1.  ;---> QUIT IF THE RESULT OF THIS PROCEDURE IS NOT NORMAL.
  1.  Q:$P(^BWDIAG(BWRESN,0),U,21)
  1.  ;
  1.  ;---> FOR PAP BWSPEC=1, FOR ANY TYPE OF MAM BWSPEC=2, OTHERWISE 0.
  1.  S BWSPEC=$S(BWPCDN=1:1,$$PMAM^BWUTL6(BWPCDN):2,1:0)
  1.  ;---> QUIT IF NOT A PAP OR MAM.
  1.  Q:'BWSPEC
  1.  ;
  1.  ;---> QUIT IF THIS IS PAP (OR MAM) AND "AUTOQUEUE NORMAL PAP (OR MAM)
  1.  ;---> LETTERS" IS SET TO "NO" IN THE SITE PARAMETERS.
  1.  Q:'$D(^BWSITE(DUZ(2),0))
  1.  Q:BWSPEC=1&('$P(^BWSITE(DUZ(2),0),U,3))
  1.  Q:BWSPEC=2&('$P(^BWSITE(DUZ(2),0),U,7))
  1.  ;
  1.  ;---> QUIT IF ANY NOTIFICATION ALREADY EXISTS FOR THIS ACCESSION#.
  1.  I $D(^BWNOT("C",BWACCN)) D  Q
  1.  .W !
  1.  .W ?5,"* (One or more Notifications already exist for this Procedure.)"
  1.  ;
  1.  ;---> SET TEXT.
  1.  S BWSPTX=$S(BWSPEC=1:"PAP",BWSPEC=2:"MAM",1:"?")
  1.  W !?5,"Q to QUEUE a """,BWSPTX," Result Normal"" letter "
  1.  W "to be sent to this patient,"
  1.  S DIR("A")=$P(DIR("A"),"or")_"Q, or <return>: "
  1.  S DIR(0)=DIR(0)_";q:QUEUE"
  1.  Q
  1.  ;
  1. CBE ;EP
  1.  ;---> ENTER A NEW CBE FOR THIS PATIENT.
  1.  Q:'$D(^BWSITE(DUZ(2),0))
  1.  Q:'$P(^BWSITE(DUZ(2),0),U,9)
  1.  W !?5,"B to add a Clinical BREAST Exam for this patient,"
  1.  S DIR("A")=$P(DIR("A"),"or")_"B, or <return>: "
  1.  S DIR(0)=DIR(0)_";b:BREAST EXAM"
  1.  Q
  1.  ; Call to expand Pre Action event on main Procedure Edit Form
  1. PREACT ;
  1.  ;D:($P($G(^BWPCD(DA,0)),U,4)'=1) UNED^DDSUTL(16,"","",1,"")
  1.  ;D:($P($G(^BWPCD(DA,0)),U,4)'=27) UNED^DDSUTL(17,"","",1,"")
  1.  D:$$COLP^BWUTL4(DA) HLP^DDSUTL(" * Move to PAGE 2 to edit clinical and pathology findings. ")
  1.  D:$G(BWCDC) HLP^DDSUTL(" * Move to PAGE 2 to edit CDC Treatment data. ")
  1.  Q