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