WVSITE ;HCIOFO/FT,JR-EDIT SITE PARAMETERS; ;2/12/04 14:17
;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
;; Original routine created by IHS/ANMC/MWR
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; CALLED BY OPTION: "WV EDIT SITE PARAMETERS".
;
; This routine uses the following IAs:
; <None>
;
; The following entry point(s) are documented by IAs:
; GETPARAM - 4101 (private)
;
D EDIT
;
EXIT ;EP
W @IOF
D KILLALL^WVUTL8
Q
;
EDIT ;EP
D SETVARS^WVUTL5
N A,B
D TITLE^WVUTL5("EDIT SITE PARAMETERS") W !
S A=" Select SITE/FACILITY: ",B=""
S:$D(DUZ(2)) B=$$INSTTX^WVUTL6(DUZ(2))
D DIC^WVFMAN(790.02,"QEMAL",.Y,A,B)
Q:Y<0
S $P(^WV(790.02,+Y,0),U,15)="v" ;set AGENCY (.15) for VA
;---> EDIT WITH SCREENMAN.
D DDS^WVFMAN(790.02,"[WV SITE PARAMS-FORM-1]",+Y)
Q
;
REF ;EP
; WV ADD/EDIT REFERRAL SOURCE option
N DIC,DIE
D TITLE^WVUTL5("ADD/EDIT REFERRAL SOURCES") W !
N S DLAYGO=790.07,DIC="^WV(790.07,",DIC("A")="Referral Source Name: "
S DIC(0)="AELMNQZ" D ^DIC I Y'>0 K DA,DR,DLAYGO,WVJDA Q
S DIE=DIC,DR=".01:1",(WVJDA,DA)=+Y
L +^WV(790.07,WVJDA):0 I $T D ^DIE L -^WV(790.07,WVJDA) K DIE,DA,DR,DIC,DLAYGO W ! G N
W !!?5,"Another user is editing this entry.",!! G N
Q
;
GETPARAM(RESULT,FIEN) ; Return WH site parameters for the facility indicated.
; Input: RESULT - Array name to return data in. Passed by reference
; (Required)
; FIEN - FILE 4 IEN (Required)
; Output: RESULT(0)=1st piece is 1 (for Success) or -1 (for Failure)
; 2nd piece is the reason for failure
; RESULT(1)=1st piece is 1 (for Yes) or 0 (for No) to
; UPDATE RESULTS/DX
; 2nd piece is 1 (for Yes) or 0 (for No) to
; UPDATE TREATMENT NEEDS
N WVNODE
I '$G(FIEN) S RESULT(0)="-1^Facility IEN is not greater than zero." Q
S WVNODE=$G(^WV(790.02,FIEN,0))
I WVNODE="" D Q
.S RESULT(0)="-1^No parameters in the Women's Health package for this facility."
.Q
S RESULT(0)="1^"
S RESULT(1)=$P(WVNODE,U,11)_U_$P(WVNODE,U,12)
S:$P(RESULT(1),U,1)="" $P(RESULT(1),U,1)=0
S:$P(RESULT(1),U,2)="" $P(RESULT(1),U,2)=0
Q
SNOMED ; [WV PAP SMEAR SNOMED CODES] option entry point
; This option is used to associate SNOMED codes with the PAP SMEAR
; entry in FILE 790.2.
N DA,DIC,DTOUT,DUOUT,WVDA,X,Y
S WVDA=$O(^WV(790.2,"B","PAP SMEAR",0))
Q:'WVDA
F D Q:(Y'>0)!($D(DTOUT))!($D(DUOUT))
.S DIC(0)="AELMQZ",DA(1)=WVDA,DLAYGO=790.2
.S DIC("A")="Select a MORPHOLOGY SNOMED CODE: "
.S DIC="^WV(790.2,DA(1),1,"
.D ^DIC
.Q:+Y'>0
.S DIE=DIC K DIC
.S DA=+Y
.S DR=".01;1"
.D ^DIE
.K DA,DIE,DR
.S:'+$G(Y) Y=.5
.Q
I $D(DTOUT)!($D(DUOUT)) Q
;
K DA,DIC,DIE,DR,X,Y
F D Q:(Y'>0)!($D(DTOUT))!($D(DUOUT))
.S DIC(0)="AELMQZ",DA(1)=WVDA,DLAYGO=790.2
.S DIC("A")="Select a TOPOGRAPHY SNOMED CODE: "
.S DIC="^WV(790.2,DA(1),2,"
.D ^DIC
.Q:+Y'>0
.S DIE=DIC K DIC
.S DA=+Y
.S DR=".01"
.D ^DIE
.K DA,DIE,DR
.S:'+$G(Y) Y=.5
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVSITE 3091 printed Sep 23, 2025@20:24:21 Page 2
WVSITE ;HCIOFO/FT,JR-EDIT SITE PARAMETERS; ;2/12/04 14:17
+1 ;;1.0;WOMEN'S HEALTH;**16**;Sep 30, 1998
+2 ;; Original routine created by IHS/ANMC/MWR
+3 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+4 ;; CALLED BY OPTION: "WV EDIT SITE PARAMETERS".
+5 ;
+6 ; This routine uses the following IAs:
+7 ; <None>
+8 ;
+9 ; The following entry point(s) are documented by IAs:
+10 ; GETPARAM - 4101 (private)
+11 ;
+12 DO EDIT
+13 ;
EXIT ;EP
+1 WRITE @IOF
+2 DO KILLALL^WVUTL8
+3 QUIT
+4 ;
EDIT ;EP
+1 DO SETVARS^WVUTL5
+2 NEW A,B
+3 DO TITLE^WVUTL5("EDIT SITE PARAMETERS")
WRITE !
+4 SET A=" Select SITE/FACILITY: "
SET B=""
+5 if $DATA(DUZ(2))
SET B=$$INSTTX^WVUTL6(DUZ(2))
+6 DO DIC^WVFMAN(790.02,"QEMAL",.Y,A,B)
+7 if Y<0
QUIT
+8 ;set AGENCY (.15) for VA
SET $PIECE(^WV(790.02,+Y,0),U,15)="v"
+9 ;---> EDIT WITH SCREENMAN.
+10 DO DDS^WVFMAN(790.02,"[WV SITE PARAMS-FORM-1]",+Y)
+11 QUIT
+12 ;
REF ;EP
+1 ; WV ADD/EDIT REFERRAL SOURCE option
+2 NEW DIC,DIE
+3 DO TITLE^WVUTL5("ADD/EDIT REFERRAL SOURCES")
WRITE !
N SET DLAYGO=790.07
SET DIC="^WV(790.07,"
SET DIC("A")="Referral Source Name: "
+1 SET DIC(0)="AELMNQZ"
DO ^DIC
IF Y'>0
KILL DA,DR,DLAYGO,WVJDA
QUIT
+2 SET DIE=DIC
SET DR=".01:1"
SET (WVJDA,DA)=+Y
+3 LOCK +^WV(790.07,WVJDA):0
IF $TEST
DO ^DIE
LOCK -^WV(790.07,WVJDA)
KILL DIE,DA,DR,DIC,DLAYGO
WRITE !
GOTO N
+4 WRITE !!?5,"Another user is editing this entry.",!!
GOTO N
+5 QUIT
+6 ;
GETPARAM(RESULT,FIEN) ; Return WH site parameters for the facility indicated.
+1 ; Input: RESULT - Array name to return data in. Passed by reference
+2 ; (Required)
+3 ; FIEN - FILE 4 IEN (Required)
+4 ; Output: RESULT(0)=1st piece is 1 (for Success) or -1 (for Failure)
+5 ; 2nd piece is the reason for failure
+6 ; RESULT(1)=1st piece is 1 (for Yes) or 0 (for No) to
+7 ; UPDATE RESULTS/DX
+8 ; 2nd piece is 1 (for Yes) or 0 (for No) to
+9 ; UPDATE TREATMENT NEEDS
+10 NEW WVNODE
+11 IF '$GET(FIEN)
SET RESULT(0)="-1^Facility IEN is not greater than zero."
QUIT
+12 SET WVNODE=$GET(^WV(790.02,FIEN,0))
+13 IF WVNODE=""
Begin DoDot:1
+14 SET RESULT(0)="-1^No parameters in the Women's Health package for this facility."
+15 QUIT
End DoDot:1
QUIT
+16 SET RESULT(0)="1^"
+17 SET RESULT(1)=$PIECE(WVNODE,U,11)_U_$PIECE(WVNODE,U,12)
+18 if $PIECE(RESULT(1),U,1)=""
SET $PIECE(RESULT(1),U,1)=0
+19 if $PIECE(RESULT(1),U,2)=""
SET $PIECE(RESULT(1),U,2)=0
+20 QUIT
SNOMED ; [WV PAP SMEAR SNOMED CODES] option entry point
+1 ; This option is used to associate SNOMED codes with the PAP SMEAR
+2 ; entry in FILE 790.2.
+3 NEW DA,DIC,DTOUT,DUOUT,WVDA,X,Y
+4 SET WVDA=$ORDER(^WV(790.2,"B","PAP SMEAR",0))
+5 if 'WVDA
QUIT
+6 FOR
Begin DoDot:1
+7 SET DIC(0)="AELMQZ"
SET DA(1)=WVDA
SET DLAYGO=790.2
+8 SET DIC("A")="Select a MORPHOLOGY SNOMED CODE: "
+9 SET DIC="^WV(790.2,DA(1),1,"
+10 DO ^DIC
+11 if +Y'>0
QUIT
+12 SET DIE=DIC
KILL DIC
+13 SET DA=+Y
+14 SET DR=".01;1"
+15 DO ^DIE
+16 KILL DA,DIE,DR
+17 if '+$GET(Y)
SET Y=.5
+18 QUIT
End DoDot:1
if (Y'>0)!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+19 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+20 ;
+21 KILL DA,DIC,DIE,DR,X,Y
+22 FOR
Begin DoDot:1
+23 SET DIC(0)="AELMQZ"
SET DA(1)=WVDA
SET DLAYGO=790.2
+24 SET DIC("A")="Select a TOPOGRAPHY SNOMED CODE: "
+25 SET DIC="^WV(790.2,DA(1),2,"
+26 DO ^DIC
+27 if +Y'>0
QUIT
+28 SET DIE=DIC
KILL DIC
+29 SET DA=+Y
+30 SET DR=".01"
+31 DO ^DIE
+32 KILL DA,DIE,DR
+33 if '+$GET(Y)
SET Y=.5
+34 QUIT
End DoDot:1
if (Y'>0)!($DATA(DTOUT))!($DATA(DUOUT))
QUIT
+35 QUIT
