| 1 | WVSITE ;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 | ;
|
|---|
| 15 | EXIT ;EP
|
|---|
| 16 | W @IOF
|
|---|
| 17 | D KILLALL^WVUTL8
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | EDIT ;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 | ;
|
|---|
| 33 | REF ;EP
|
|---|
| 34 | ; WV ADD/EDIT REFERRAL SOURCE option
|
|---|
| 35 | N DIC,DIE
|
|---|
| 36 | D TITLE^WVUTL5("ADD/EDIT REFERRAL SOURCES") W !
|
|---|
| 37 | N 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 | ;
|
|---|
| 44 | GETPARAM(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
|
|---|
| 65 | SNOMED ; [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
|
|---|
