BWLAB.m

BWLAB ;IHS/ANMC/MWR - ADD/EDIT PROCEDURE BY LAB STAFF;15-Feb-2003 21:55;PLS

 ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 ;;  CALLED BY OPTION: "BW LAB ADD A NEW PROCEDURE" TO ACCESSION

 ;;  PROCEDURES.

 ;

 D SETVARS^BWUTL5

 F  D  Q:BWPOP

 .D TITLE^BWUTL5("LAB: ENTER NEW PROCEDURES")

 .D NEW

 D EXIT

 Q

 ;

NEW ;EP

 ;---> SELECT PATIENT.

 S BWPOP=0 N BWDFN,DIR,DR

 D PATLKUP^BWUTL8(.Y,"ADD","NOCDC")

 I Y<0 S BWPOP=1 Q

 S BWDFN=+Y

 ;---> SELECT PROCEDURE.

 D NEW1^BWPROC I BWPOP S BWPOP=0 Q

 I '$G(DA) D  Q

 .W !?5,"* FAILURE TO ADD NEW PROCEDURE.  "

 .W "PLEASE CONTACT YOUR SITE MANAGER" D DIRZ^BWUTL3

 D EDIT2(DA)

 Q

 ;

EDIT ;EP

 ;---> CALLED BY OPTION: "BW LAB EDIT ACCESSION".

 ;---> EDIT JUST THE ACCESSION FIELDS OF AN EXISTING PROCEDURE.

 D SETVARS^BWUTL5

 D TITLE^BWUTL5("EDIT AN ACCESSIONED PROCEDURE")

 D LKUPPCD^BWPROC(.Y)

 Q:Y<0!($D(DIROUT))

 ;---> DA=IEN OF PROCEDURE IN PROCEDURE FILE 9002086.1.

 S DA=+Y

 D EDIT2(DA)

 D EXIT

 Q

 ;

 ;

EDIT2(DA) ;EP

 ;---> REQUIRED VARIABLES: DA=IEN IN ^BWPCD(.

 Q:'$G(DA)

 S (AUPNPAT,BWDFN)=$P(^BWPCD(DA,0),U,2)

 D DDS^BWFMAN(9002086.1,"[BW PROC-FORM-LAB]",DA,"C",.BWCHG,.BWPOP)

 Q

 ;

EXIT ;EP

 D KILLALL^BWUTL8

 Q

BWLAB     ;IHS/ANMC/MWR - ADD/EDIT PROCEDURE BY LAB STAFF;15-Feb-2003 21:55;PLS

 +1       ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996

 +2       ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *

 +3       ;;  CALLED BY OPTION: "BW LAB ADD A NEW PROCEDURE" TO ACCESSION

 +4       ;;  PROCEDURES.

 +5       ;

 +6        DO SETVARS^BWUTL5

 +7        FOR 

               Begin DoDot:1

 +8                DO TITLE^BWUTL5("LAB: ENTER NEW PROCEDURES")

 +9                DO NEW

               End DoDot:1

               IF BWPOP

                   QUIT 

 +10       DO EXIT

 +11       QUIT 

 +12      ;

NEW       ;EP

 +1       ;---> SELECT PATIENT.

 +2        SET BWPOP=0

           NEW BWDFN,DIR,DR

 +3        DO PATLKUP^BWUTL8(.Y,"ADD","NOCDC")

 +4        IF Y<0

               SET BWPOP=1

               QUIT 

 +5        SET BWDFN=+Y

 +6       ;---> SELECT PROCEDURE.

 +7        DO NEW1^BWPROC

           IF BWPOP

               SET BWPOP=0

               QUIT 

 +8        IF '$GET(DA)

               Begin DoDot:1

 +9                WRITE !?5,"* FAILURE TO ADD NEW PROCEDURE.  "

 +10               WRITE "PLEASE CONTACT YOUR SITE MANAGER"

                   DO DIRZ^BWUTL3

               End DoDot:1

               QUIT 

 +11       DO EDIT2(DA)

 +12       QUIT 

 +13      ;

EDIT      ;EP

 +1       ;---> CALLED BY OPTION: "BW LAB EDIT ACCESSION".

 +2       ;---> EDIT JUST THE ACCESSION FIELDS OF AN EXISTING PROCEDURE.

 +3        DO SETVARS^BWUTL5

 +4        DO TITLE^BWUTL5("EDIT AN ACCESSIONED PROCEDURE")

 +5        DO LKUPPCD^BWPROC(.Y)

 +6        IF Y<0!($DATA(DIROUT))

               QUIT 

 +7       ;---> DA=IEN OF PROCEDURE IN PROCEDURE FILE 9002086.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 ^BWPCD(.

 +2        IF '$GET(DA)

               QUIT 

 +3        SET (AUPNPAT,BWDFN)=$PIECE(^BWPCD(DA,0),U,2)

 +4        DO DDS^BWFMAN(9002086.1,"[BW PROC-FORM-LAB]",DA,"C",.BWCHG,.BWPOP)

 +5        QUIT 

 +6       ;

EXIT      ;EP

 +1        DO KILLALL^BWUTL8

 +2        QUIT