WVLAB ;HCIOFO/FT IHS/ANMC/MWR - ADD/EDIT PROCEDURE BY LAB STAFF; ;12/15/98 11:23
;;1.0;WOMEN'S HEALTH;**3**;Sep 30, 1998
;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
;; CALLED BY OPTION: "WV LAB ADD A NEW PROCEDURE" TO ACCESSION
;; PROCEDURES.
;
D SETVARS^WVUTL5
F D Q:WVPOP
.D TITLE^WVUTL5("LAB: ENTER NEW PROCEDURES")
.D NEW
D EXIT
Q
;
NEW ;EP
;---> SELECT PATIENT.
S WVPOP=0 N WVDFN,DIR,DR
; Quit if no default case manager
I '$$DCM^WVUTL9(DUZ(2)) D NODCM^WVUTL9 S WVPOP=1 Q
D PATLKUP^WVUTL8(.Y,"ADD")
I Y<0 S WVPOP=1 Q
S WVDFN=+Y
;---> SELECT PROCEDURE.
D NEW1^WVPROC I WVPOP S WVPOP=0 Q
I '$G(DA) D Q
.W !?5,"* FAILURE TO ADD NEW PROCEDURE. "
.W "PLEASE CONTACT YOUR SITE MANAGER" D DIRZ^WVUTL3
D EDIT2(DA)
Q
;
EDIT ;EP
;---> CALLED BY OPTION: "WV LAB EDIT ACCESSION".
;---> EDIT JUST THE ACCESSION FIELDS OF AN EXISTING PROCEDURE.
D SETVARS^WVUTL5
D TITLE^WVUTL5("EDIT AN ACCESSIONED PROCEDURE")
D LKUPPCD^WVPROC(.Y)
Q:Y<0!($D(DIROUT))
;---> DA=IEN OF PROCEDURE IN PROCEDURE FILE 790.1.
S DA=+Y
D EDIT2(DA)
D EXIT
Q
;
;
EDIT2(DA) ;EP
;---> REQUIRED VARIABLES: DA=IEN IN ^WV(790.1,.
Q:'$G(DA)
S WVDFN=$P(^WV(790.1,DA,0),U,2)
D DDS^WVFMAN(790.1,"[WV PROC-FORM-LAB]",DA,"C",.WVCHG,.WVPOP)
Q
;
EXIT ;EP
D KILLALL^WVUTL8
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVLAB 1347 printed Dec 13, 2024@02:47:01 Page 2
WVLAB ;HCIOFO/FT IHS/ANMC/MWR - ADD/EDIT PROCEDURE BY LAB STAFF; ;12/15/98 11:23
+1 ;;1.0;WOMEN'S HEALTH;**3**;Sep 30, 1998
+2 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
+3 ;; CALLED BY OPTION: "WV LAB ADD A NEW PROCEDURE" TO ACCESSION
+4 ;; PROCEDURES.
+5 ;
+6 DO SETVARS^WVUTL5
+7 FOR
Begin DoDot:1
+8 DO TITLE^WVUTL5("LAB: ENTER NEW PROCEDURES")
+9 DO NEW
End DoDot:1
if WVPOP
QUIT
+10 DO EXIT
+11 QUIT
+12 ;
NEW ;EP
+1 ;---> SELECT PATIENT.
+2 SET WVPOP=0
NEW WVDFN,DIR,DR
+3 ; Quit if no default case manager
+4 IF '$$DCM^WVUTL9(DUZ(2))
DO NODCM^WVUTL9
SET WVPOP=1
QUIT
+5 DO PATLKUP^WVUTL8(.Y,"ADD")
+6 IF Y<0
SET WVPOP=1
QUIT
+7 SET WVDFN=+Y
+8 ;---> SELECT PROCEDURE.
+9 DO NEW1^WVPROC
IF WVPOP
SET WVPOP=0
QUIT
+10 IF '$GET(DA)
Begin DoDot:1
+11 WRITE !?5,"* FAILURE TO ADD NEW PROCEDURE. "
+12 WRITE "PLEASE CONTACT YOUR SITE MANAGER"
DO DIRZ^WVUTL3
End DoDot:1
QUIT
+13 DO EDIT2(DA)
+14 QUIT
+15 ;
EDIT ;EP
+1 ;---> CALLED BY OPTION: "WV LAB EDIT ACCESSION".
+2 ;---> EDIT JUST THE ACCESSION FIELDS OF AN EXISTING PROCEDURE.
+3 DO SETVARS^WVUTL5
+4 DO TITLE^WVUTL5("EDIT AN ACCESSIONED PROCEDURE")
+5 DO LKUPPCD^WVPROC(.Y)
+6 if Y<0!($DATA(DIROUT))
QUIT
+7 ;---> DA=IEN OF PROCEDURE IN PROCEDURE FILE 790.1.
+8 SET DA=+Y
+9 DO EDIT2(DA)
+10 DO EXIT
+11 QUIT
+12 ;
+13 ;
EDIT2(DA) ;EP
+1 ;---> REQUIRED VARIABLES: DA=IEN IN ^WV(790.1,.
+2 if '$GET(DA)
QUIT
+3 SET WVDFN=$PIECE(^WV(790.1,DA,0),U,2)
+4 DO DDS^WVFMAN(790.1,"[WV PROC-FORM-LAB]",DA,"C",.WVCHG,.WVPOP)
+5 QUIT
+6 ;
EXIT ;EP
+1 DO KILLALL^WVUTL8
+2 QUIT
