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

WVPROC1.m

Go to the documentation of this file.
  1. WVPROC1 ;HCIOFO/FT,JR IHS/ANMC/MWR - WV ADD/EDIT WV PROCEDURE; ;1/26/01 15:12
  1. ;;1.0;WOMEN'S HEALTH;**14**;Sep 30, 1998
  1. ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1. ;; EDIT A PROCEDURE, ALSO FOLLOW-UP SCREEN. CALLED BY WVPROC.
  1. ;
  1. ;
  1. EDIT2(DA,WVPOP) ;EP
  1. ;---> EDIT A PROCEDURE.
  1. ;---> REQUIRED VARIABLES: DA=IEN IN ^WV(790.1,.
  1. S WVPOP=0
  1. I '$G(DA) D D OUT^WVUTL3 Q
  1. .W !,"NO PROCEDURE (DA). PLEASE CONTACT YOUR SITE MANAGER."
  1. I '$D(^WV(790.1,DA,0)) D D OUT^WVUTL3 Q
  1. .W !,"^WV(790.1, NOT DEFINED. PLEASE CONTACT YOUR SITE MANAGER."
  1. S WVDFN=$P(^WV(790.1,DA,0),U,2)
  1. D SCREEN(DA,.WVPOP)
  1. ;---> IF ENTRY WAS LOCKED, WVPOP=1.
  1. Q:WVPOP
  1. Q
  1. ;
  1. SCREEN(DA,WVPOP) ;EP
  1. ;---> EDIT A PROCEDURE WITH SCREENMAN.
  1. ;---> REQUIRED VARIABLES: DA=IEN IN PROCEDURE FILE.
  1. ;---> STORE OLD ZERO NODE VALUES IN WVOLD TO COMPARE FOR EDITS,
  1. ;---> STORE OLD 2 NODE VALUES IN WVOLD2.
  1. ;
  1. N WVOLD,WVOLD2,WVPCDN,DDSFILE,DR,Y
  1. S DDSFILE=790.1
  1. S WVOLD=^WV(790.1,DA,0) S:$D(^(2)) WVOLD2=^WV(790.1,DA,2)
  1. S WVPCDN=$P(WVOLD,U,4)
  1. ;
  1. ;---> SET DR=TO THE APPROPRIATE FORM.
  1. D
  1. .;---> IF THIS IS A COLPOSCOPY-TYPE PROCEDURE, USE FORM-2.
  1. .I $$COLP^WVUTL4(DA) S DR="[WV PROC-FORM-2-COLP]" Q
  1. .;
  1. .;---> OTHERWISE, USE FORM 1 (ONLY PAGE 1).
  1. .S DR="[WV PROC-FORM-1]"
  1. ;
  1. ;---> CALL SCREENMAN.
  1. D DDS^WVFMAN(DDSFILE,DR,DA,"","",.WVPOP)
  1. Q:WVPOP
  1. Q
  1. ;
  1. ;
  1. FOLLOWUP(WVDA) ;EP
  1. ;---> PROCEDURE FOLLOW-UP MENU.
  1. ;---> REQUIRED VARIABLES: WVDA=IEN IN PROCEDURE FILE.
  1. ;---> WVLOOP TELLS WVNOTIF (ADD NEW NOTIFICATION) NOT TO OFFER TO EDIT
  1. ;---> CASE DATA, SINCE THAT OPTION IS ALREADY OFFERED IN THIS LOOP.
  1. Q ;dead code?
  1. ;
  1. NORMAL ;EP
  1. ;---> IF RESULT IS NORMAL, ASK TO QUEUE NORMAL PAP/MAM LETTER.
  1. ;---> QUIT IF VARIABLES NOT ADEQUATE.
  1. N DIR,DIRUT,WVSPEC,WVSPTX,X,Y
  1. Q:'$G(WVPCDN)!('$G(WVRESN))!('$D(WVACCN))
  1. ;
  1. ;---> QUIT IF THE RESULT OF THIS PROCEDURE IS NOT NORMAL.
  1. Q:$P(^WV(790.31,WVRESN,0),U,21)
  1. ;
  1. ;---> FOR PAP WVSPEC=1, FOR ANY TYPE OF MAM WVSPEC=2, OTHERWISE 0.
  1. S WVSPEC=$S(WVPCDN=1:1,$$PMAM^WVUTL6(WVPCDN):2,1:0)
  1. ;---> QUIT IF NOT A PAP OR MAM.
  1. Q:'WVSPEC
  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(^WV(790.02,DUZ(2),0))
  1. Q:WVSPEC=1&('$P(^WV(790.02,DUZ(2),0),U,3))
  1. Q:WVSPEC=2&('$P(^WV(790.02,DUZ(2),0),U,7))
  1. ;
  1. ;---> QUIT IF ANY NOTIFICATION ALREADY EXISTS FOR THIS ACCESSION#.
  1. I $D(^WV(790.4,"C",WVACCN)) Q ;D Q
  1. ;.W !!
  1. ;.W ?5,"* (One or more Notifications already exist for this Procedure.)"
  1. ;
  1. ;---> SET TEXT.
  1. S WVSPTX=$S(WVSPEC=1:"PAP",WVSPEC=2:"MAM",1:"?")
  1. W !!!
  1. S DIR("A")="QUEUE a "_WVSPTX_" Result Normal letter to be sent to this patient"
  1. S DIR(0)="Y"
  1. D ^DIR
  1. Q:$D(DIRUT)!(Y=0)
  1. D NORMALL^WVNOTIF1(WVDFN,WVACCN,WVSPEC,WVSPTX)
  1. Q
  1. ;