source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVPROC1.m@ 1042

Last change on this file since 1042 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1WVPROC1 ;HCIOFO/FT,JR IHS/ANMC/MWR - WV ADD/EDIT WV PROCEDURE; ;1/26/01 15:12
2 ;;1.0;WOMEN'S HEALTH;**14**;Sep 30, 1998
3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
4 ;; EDIT A PROCEDURE, ALSO FOLLOW-UP SCREEN. CALLED BY WVPROC.
5 ;
6 ;
7EDIT2(DA,WVPOP) ;EP
8 ;---> EDIT A PROCEDURE.
9 ;---> REQUIRED VARIABLES: DA=IEN IN ^WV(790.1,.
10 S WVPOP=0
11 I '$G(DA) D D OUT^WVUTL3 Q
12 .W !,"NO PROCEDURE (DA). PLEASE CONTACT YOUR SITE MANAGER."
13 I '$D(^WV(790.1,DA,0)) D D OUT^WVUTL3 Q
14 .W !,"^WV(790.1, NOT DEFINED. PLEASE CONTACT YOUR SITE MANAGER."
15 S WVDFN=$P(^WV(790.1,DA,0),U,2)
16 D SCREEN(DA,.WVPOP)
17 ;---> IF ENTRY WAS LOCKED, WVPOP=1.
18 Q:WVPOP
19 Q
20 ;
21SCREEN(DA,WVPOP) ;EP
22 ;---> EDIT A PROCEDURE WITH SCREENMAN.
23 ;---> REQUIRED VARIABLES: DA=IEN IN PROCEDURE FILE.
24 ;---> STORE OLD ZERO NODE VALUES IN WVOLD TO COMPARE FOR EDITS,
25 ;---> STORE OLD 2 NODE VALUES IN WVOLD2.
26 ;
27 N WVOLD,WVOLD2,WVPCDN,DDSFILE,DR,Y
28 S DDSFILE=790.1
29 S WVOLD=^WV(790.1,DA,0) S:$D(^(2)) WVOLD2=^WV(790.1,DA,2)
30 S WVPCDN=$P(WVOLD,U,4)
31 ;
32 ;---> SET DR=TO THE APPROPRIATE FORM.
33 D
34 .;---> IF THIS IS A COLPOSCOPY-TYPE PROCEDURE, USE FORM-2.
35 .I $$COLP^WVUTL4(DA) S DR="[WV PROC-FORM-2-COLP]" Q
36 .;
37 .;---> OTHERWISE, USE FORM 1 (ONLY PAGE 1).
38 .S DR="[WV PROC-FORM-1]"
39 ;
40 ;---> CALL SCREENMAN.
41 D DDS^WVFMAN(DDSFILE,DR,DA,"","",.WVPOP)
42 Q:WVPOP
43 Q
44 ;
45 ;
46FOLLOWUP(WVDA) ;EP
47 ;---> PROCEDURE FOLLOW-UP MENU.
48 ;---> REQUIRED VARIABLES: WVDA=IEN IN PROCEDURE FILE.
49 ;---> WVLOOP TELLS WVNOTIF (ADD NEW NOTIFICATION) NOT TO OFFER TO EDIT
50 ;---> CASE DATA, SINCE THAT OPTION IS ALREADY OFFERED IN THIS LOOP.
51 Q ;dead code?
52 ;
53NORMAL ;EP
54 ;---> IF RESULT IS NORMAL, ASK TO QUEUE NORMAL PAP/MAM LETTER.
55 ;---> QUIT IF VARIABLES NOT ADEQUATE.
56 N DIR,DIRUT,WVSPEC,WVSPTX,X,Y
57 Q:'$G(WVPCDN)!('$G(WVRESN))!('$D(WVACCN))
58 ;
59 ;---> QUIT IF THE RESULT OF THIS PROCEDURE IS NOT NORMAL.
60 Q:$P(^WV(790.31,WVRESN,0),U,21)
61 ;
62 ;---> FOR PAP WVSPEC=1, FOR ANY TYPE OF MAM WVSPEC=2, OTHERWISE 0.
63 S WVSPEC=$S(WVPCDN=1:1,$$PMAM^WVUTL6(WVPCDN):2,1:0)
64 ;---> QUIT IF NOT A PAP OR MAM.
65 Q:'WVSPEC
66 ;
67 ;---> QUIT IF THIS IS PAP (OR MAM) AND "AUTOQUEUE NORMAL PAP (OR MAM)
68 ;---> LETTERS" IS SET TO "NO" IN THE SITE PARAMETERS.
69 Q:'$D(^WV(790.02,DUZ(2),0))
70 Q:WVSPEC=1&('$P(^WV(790.02,DUZ(2),0),U,3))
71 Q:WVSPEC=2&('$P(^WV(790.02,DUZ(2),0),U,7))
72 ;
73 ;---> QUIT IF ANY NOTIFICATION ALREADY EXISTS FOR THIS ACCESSION#.
74 I $D(^WV(790.4,"C",WVACCN)) Q ;D Q
75 ;.W !!
76 ;.W ?5,"* (One or more Notifications already exist for this Procedure.)"
77 ;
78 ;---> SET TEXT.
79 S WVSPTX=$S(WVSPEC=1:"PAP",WVSPEC=2:"MAM",1:"?")
80 W !!!
81 S DIR("A")="QUEUE a "_WVSPTX_" Result Normal letter to be sent to this patient"
82 S DIR(0)="Y"
83 D ^DIR
84 Q:$D(DIRUT)!(Y=0)
85 D NORMALL^WVNOTIF1(WVDFN,WVACCN,WVSPEC,WVSPTX)
86 Q
87 ;
Note: See TracBrowser for help on using the repository browser.