source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVSITE.m@ 1608

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

initial load of WorldVistAEHR
File size: 2.9 KB
RevLine 
[613]1WVSITE ;HCIOFO/FT,JR-EDIT SITE PARAMETERS; ;2/12/04 14:17
2 ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
3 ;; Original routine created by IHS/ANMC/MWR
4 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
5 ;; CALLED BY OPTION: "WV EDIT SITE PARAMETERS".
6 ;
7 ; This routine uses the following IAs:
8 ; <None>
9 ;
10 ; The following entry point(s) are documented by IAs:
11 ; GETPARAM - 4101 (private)
12 ;
13 D EDIT
14 ;
15EXIT ;EP
16 W @IOF
17 D KILLALL^WVUTL8
18 Q
19 ;
20EDIT ;EP
21 D SETVARS^WVUTL5
22 N A,B
23 D TITLE^WVUTL5("EDIT SITE PARAMETERS") W !
24 S A=" Select SITE/FACILITY: ",B=""
25 S:$D(DUZ(2)) B=$$INSTTX^WVUTL6(DUZ(2))
26 D DIC^WVFMAN(790.02,"QEMAL",.Y,A,B)
27 Q:Y<0
28 S $P(^WV(790.02,+Y,0),U,15)="v" ;set AGENCY (.15) for VA
29 ;---> EDIT WITH SCREENMAN.
30 D DDS^WVFMAN(790.02,"[WV SITE PARAMS-FORM-1]",+Y)
31 Q
32 ;
33REF ;EP
34 ; WV ADD/EDIT REFERRAL SOURCE option
35 N DIC,DIE
36 D TITLE^WVUTL5("ADD/EDIT REFERRAL SOURCES") W !
37N S DLAYGO=790.07,DIC="^WV(790.07,",DIC("A")="Referral Source Name: "
38 S DIC(0)="AELMNQZ" D ^DIC I Y'>0 K DA,DR,DLAYGO,WVJDA Q
39 S DIE=DIC,DR=".01:1",(WVJDA,DA)=+Y
40 L +^WV(790.07,WVJDA):0 I $T D ^DIE L -^WV(790.07,WVJDA) K DIE,DA,DR,DIC,DLAYGO W ! G N
41 W !!?5,"Another user is editing this entry.",!! G N
42 Q
43 ;
44GETPARAM(RESULT,FIEN) ; Return WH site parameters for the facility indicated.
45 ; Input: RESULT - Array name to return data in. Passed by reference
46 ; (Required)
47 ; FIEN - FILE 4 IEN (Required)
48 ; Output: RESULT(0)=1st piece is 1 (for Success) or -1 (for Failure)
49 ; 2nd piece is the reason for failure
50 ; RESULT(1)=1st piece is 1 (for Yes) or 0 (for No) to
51 ; UPDATE RESULTS/DX
52 ; 2nd piece is 1 (for Yes) or 0 (for No) to
53 ; UPDATE TREATMENT NEEDS
54 N WVNODE
55 I '$G(FIEN) S RESULT(0)="-1^Facility IEN is not greater than zero." Q
56 S WVNODE=$G(^WV(790.02,FIEN,0))
57 I WVNODE="" D Q
58 .S RESULT(0)="-1^No parameters in the Women's Health package for this facility."
59 .Q
60 S RESULT(0)="1^"
61 S RESULT(1)=$P(WVNODE,U,11)_U_$P(WVNODE,U,12)
62 S:$P(RESULT(1),U,1)="" $P(RESULT(1),U,1)=0
63 S:$P(RESULT(1),U,2)="" $P(RESULT(1),U,2)=0
64 Q
65SNOMED ; [WV PAP SMEAR SNOMED CODES] option entry point
66 ; This option is used to associate SNOMED codes with the PAP SMEAR
67 ; entry in FILE 790.2.
68 N DA,DIC,DTOUT,DUOUT,WVDA,X,Y
69 S WVDA=$O(^WV(790.2,"B","PAP SMEAR",0))
70 Q:'WVDA
71 F D Q:(Y'>0)!($D(DTOUT))!($D(DUOUT))
72 .S DIC(0)="AELMQZ",DA(1)=WVDA,DLAYGO=790.2
73 .S DIC("A")="Select a MORPHOLOGY SNOMED CODE: "
74 .S DIC="^WV(790.2,DA(1),1,"
75 .D ^DIC
76 .Q:+Y'>0
77 .S DIE=DIC K DIC
78 .S DA=+Y
79 .S DR=".01;1"
80 .D ^DIE
81 .K DA,DIE,DR
82 .S:'+$G(Y) Y=.5
83 .Q
84 I $D(DTOUT)!($D(DUOUT)) Q
85 ;
86 K DA,DIC,DIE,DR,X,Y
87 F D Q:(Y'>0)!($D(DTOUT))!($D(DUOUT))
88 .S DIC(0)="AELMQZ",DA(1)=WVDA,DLAYGO=790.2
89 .S DIC("A")="Select a TOPOGRAPHY SNOMED CODE: "
90 .S DIC="^WV(790.2,DA(1),2,"
91 .D ^DIC
92 .Q:+Y'>0
93 .S DIE=DIC K DIC
94 .S DA=+Y
95 .S DR=".01"
96 .D ^DIE
97 .K DA,DIE,DR
98 .S:'+$G(Y) Y=.5
99 .Q
100 Q
Note: See TracBrowser for help on using the repository browser.