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

WVSITE.m

Go to the documentation of this file. 
  1. WVSITE ;HCIOFO/FT,JR-EDIT SITE PARAMETERS; ;2/12/04  14:17
  1.  ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
  1.  ;;  Original routine created by IHS/ANMC/MWR
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  CALLED BY OPTION: "WV EDIT SITE PARAMETERS".
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ; <None>
  1.  ;
  1.  ; The following entry point(s) are documented by IAs:
  1.  ; GETPARAM  -  4101   (private)
  1.  ;
  1.  D EDIT
  1.  ;
  1. EXIT ;EP
  1.  W @IOF
  1.  D KILLALL^WVUTL8
  1.  Q
  1.  ;
  1. EDIT ;EP
  1.  D SETVARS^WVUTL5
  1.  N A,B
  1.  D TITLE^WVUTL5("EDIT SITE PARAMETERS") W !
  1.  S A="   Select SITE/FACILITY: ",B=""
  1.  S:$D(DUZ(2)) B=$$INSTTX^WVUTL6(DUZ(2))
  1.  D DIC^WVFMAN(790.02,"QEMAL",.Y,A,B)
  1.  Q:Y<0
  1.  S $P(^WV(790.02,+Y,0),U,15)="v" ;set AGENCY (.15) for VA
  1.  ;---> EDIT WITH SCREENMAN.
  1.  D DDS^WVFMAN(790.02,"[WV SITE PARAMS-FORM-1]",+Y)
  1.  Q
  1.  ;
  1. REF ;EP
  1.  ; WV ADD/EDIT REFERRAL SOURCE option
  1.  N DIC,DIE
  1.  D TITLE^WVUTL5("ADD/EDIT REFERRAL SOURCES") W !
  1. N S DLAYGO=790.07,DIC="^WV(790.07,",DIC("A")="Referral Source Name: "
  1.  S DIC(0)="AELMNQZ" D ^DIC I Y'>0 K DA,DR,DLAYGO,WVJDA Q
  1.  S DIE=DIC,DR=".01:1",(WVJDA,DA)=+Y
  1.  L +^WV(790.07,WVJDA):0 I $T D ^DIE L -^WV(790.07,WVJDA) K DIE,DA,DR,DIC,DLAYGO W ! G N
  1.  W !!?5,"Another user is editing this entry.",!! G N
  1.  Q
  1.  ;
  1. GETPARAM(RESULT,FIEN) ; Return WH site parameters for the facility indicated.
  1.  ;  Input: RESULT - Array name to return data in. Passed by reference
  1.  ;                  (Required)
  1.  ;           FIEN - FILE 4 IEN (Required)
  1.  ; Output: RESULT(0)=1st piece is 1 (for Success) or -1 (for Failure)
  1.  ;                   2nd piece is the reason for failure
  1.  ;         RESULT(1)=1st piece is 1 (for Yes) or 0 (for No) to
  1.  ;                                UPDATE RESULTS/DX 
  1.  ;                   2nd piece is 1 (for Yes) or 0 (for No) to
  1.  ;                                UPDATE TREATMENT NEEDS
  1.  N WVNODE
  1.  I '$G(FIEN) S RESULT(0)="-1^Facility IEN is not greater than zero." Q
  1.  S WVNODE=$G(^WV(790.02,FIEN,0))
  1.  I WVNODE="" D  Q
  1.  .S RESULT(0)="-1^No parameters in the Women's Health package for this facility."
  1.  .Q
  1.  S RESULT(0)="1^"
  1.  S RESULT(1)=$P(WVNODE,U,11)_U_$P(WVNODE,U,12)
  1.  S:$P(RESULT(1),U,1)="" $P(RESULT(1),U,1)=0
  1.  S:$P(RESULT(1),U,2)="" $P(RESULT(1),U,2)=0
  1.  Q
  1. SNOMED ; [WV PAP SMEAR SNOMED CODES] option entry point
  1.  ; This option is used to associate SNOMED codes with the PAP SMEAR
  1.  ; entry in FILE 790.2.
  1.  N DA,DIC,DTOUT,DUOUT,WVDA,X,Y
  1.  S WVDA=$O(^WV(790.2,"B","PAP SMEAR",0))
  1.  Q:'WVDA
  1.  F  D  Q:(Y'>0)!($D(DTOUT))!($D(DUOUT))
  1.  .S DIC(0)="AELMQZ",DA(1)=WVDA,DLAYGO=790.2
  1.  .S DIC("A")="Select a MORPHOLOGY SNOMED CODE: "
  1.  .S DIC="^WV(790.2,DA(1),1,"
  1.  .D ^DIC
  1.  .Q:+Y'>0
  1.  .S DIE=DIC K DIC
  1.  .S DA=+Y
  1.  .S DR=".01;1"
  1.  .D ^DIE
  1.  .K DA,DIE,DR
  1.  .S:'+$G(Y) Y=.5
  1.  .Q
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  ;
  1.  K DA,DIC,DIE,DR,X,Y
  1.  F  D  Q:(Y'>0)!($D(DTOUT))!($D(DUOUT))
  1.  .S DIC(0)="AELMQZ",DA(1)=WVDA,DLAYGO=790.2
  1.  .S DIC("A")="Select a TOPOGRAPHY SNOMED CODE: "
  1.  .S DIC="^WV(790.2,DA(1),2,"
  1.  .D ^DIC
  1.  .Q:+Y'>0
  1.  .S DIE=DIC K DIC
  1.  .S DA=+Y
  1.  .S DR=".01"
  1.  .D ^DIE
  1.  .K DA,DIE,DR
  1.  .S:'+$G(Y) Y=.5
  1.  .Q
  1.  Q