WVLAB.m

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 ---WVLAB   1347     printed  Apr 09, 2024@21:50:02                                                                                                                                                                                                       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