BWFACE.m

BWFACE ;IHS/ANMC/MWR - PRINT A FACE SHEET (FROM REG.);15-Feb-2003 21:51;PLS

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

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

 ;;  DISPLAY/PRINT A FACE SHEET, FROM IHS REGISTRATION.

 ;

 D SETVARS^BWUTL5 S BWPOP1=0

 F  D RUN Q:BWPOP1

 W @IOF

 D EXIT

 Q

 ;

RUN ;EP

 D TITLE^BWUTL5("DISPLAY/PRINT A PATIENT FACE SHEET")

 D PATIENT I Y<0 S BWPOP1=1 Q

 ;

RUN1 ;EP

 ;---> PATIENT ALREADY SELECTED.

 D DEVICE Q:BWPOP

 D FACE

 Q

 ;

EXIT ;EP

 D KILLALL^BWUTL8

 Q

 ;

 ;

PATIENT ;EP

 ;---> SELECT PATIENT (RETURN BWDFN).

 W !!,"   Select the patient whose Face Sheet you wish to display."

 D PATLKUP^BWUTL8(.Y)

 Q:Y<0  S BWDFN=+Y

 Q

 ;

 ;

DEVICE ;EP

 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.

 S ZTRTN="DEQUEUE^BWFACE",ZTSAVE("BWDFN")=""

 D ZIS^BWUTL2(.BWPOP,1)

 Q

 ;

 ;

FACE ;EP

 ;---> DISPLAY CODE FOR FACE SHEET.

 U IO

 S BWCRT=$S($E(IOST)="C":1,1:0)

 I BWCRT N IOF S IOF="!"

 D

 .I '$D(BWDFN) W !?5,"A Patient has not been selected.",! Q

 .S DFN=BWDFN

 .;

 .;---> IF THIS IS NOT IHS, DO NOT CALL IHS REGISTRATION FACE SHEET.

 .;---> VA/STATE SITES MAY SUBSTITUTE AN ALTERNATE CALL BELOW.

 .I $$AGENCY^BWUTL5(DUZ(2))'="i" D  Q

 ..;---> VA/STATE SUBSTITUTE ALTERNATE PATIENT INQUIRY CODE HERE:

 ..;D ^VA_ROUTINE SUCH AS EN^DGRPD, AND QUIT.

 ..;EXAMPLE: D EN^DGRPD Q

 ..W !!?8,"* Because this is not an Indian Health Service site,"

 ..W !?10,"the program cannot display an IHS Face Sheet."

 ..W !?10,"Contact your technical support people to modify"

 ..W !?10,"line FACE+13 of the routine BWFACE."

 .;

 .S DFN=BWDFN D START^AGFACE

 I BWCRT D DIRZ^BWUTL3 W @IOF

 D ^%ZISC

 Q

 ;

FOLLUP(BWDFN) ;EP

 ;---> CALLED BY PROCEDURE FOLLOW-UP MENU (BWPROC1).

 N (BWDFN,DT,DTIME,DUZ,IO,U) D SETVARS^BWUTL5

 D RUN1

 Q

 ;

DEQUEUE ;EP

 ;---> EP FOR TASKMAN QUEUE OF PRINTOUT.

 D SETVARS^BWUTL5,FACE^BWFACE,EXIT

 Q

BWFACE    ;IHS/ANMC/MWR - PRINT A FACE SHEET (FROM REG.);15-Feb-2003 21:51;PLS

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

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

 +3       ;;  DISPLAY/PRINT A FACE SHEET, FROM IHS REGISTRATION.

 +4       ;

 +5        DO SETVARS^BWUTL5

           SET BWPOP1=0

 +6        FOR 

               DO RUN

               IF BWPOP1

                   QUIT 

 +7        WRITE @IOF

 +8        DO EXIT

 +9        QUIT 

 +10      ;

RUN       ;EP

 +1        DO TITLE^BWUTL5("DISPLAY/PRINT A PATIENT FACE SHEET")

 +2        DO PATIENT

           IF Y<0

               SET BWPOP1=1

               QUIT 

 +3       ;

RUN1      ;EP

 +1       ;---> PATIENT ALREADY SELECTED.

 +2        DO DEVICE

           IF BWPOP

               QUIT 

 +3        DO FACE

 +4        QUIT 

 +5       ;

EXIT      ;EP

 +1        DO KILLALL^BWUTL8

 +2        QUIT 

 +3       ;

 +4       ;

PATIENT   ;EP

 +1       ;---> SELECT PATIENT (RETURN BWDFN).

 +2        WRITE !!,"   Select the patient whose Face Sheet you wish to display."

 +3        DO PATLKUP^BWUTL8(.Y)

 +4        IF Y<0

               QUIT 

           SET BWDFN=+Y

 +5        QUIT 

 +6       ;

 +7       ;

DEVICE    ;EP

 +1       ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.

 +2        SET ZTRTN="DEQUEUE^BWFACE"

           SET ZTSAVE("BWDFN")=""

 +3        DO ZIS^BWUTL2(.BWPOP,1)

 +4        QUIT 

 +5       ;

 +6       ;

FACE      ;EP

 +1       ;---> DISPLAY CODE FOR FACE SHEET.

 +2        USE IO

 +3        SET BWCRT=$SELECT($EXTRACT(IOST)="C":1,1:0)

 +4        IF BWCRT

               NEW IOF

               SET IOF="!"

 +5        Begin DoDot:1

 +6            IF '$DATA(BWDFN)

                   WRITE !?5,"A Patient has not been selected.",!

                   QUIT 

 +7            SET DFN=BWDFN

 +8       ;

 +9       ;---> IF THIS IS NOT IHS, DO NOT CALL IHS REGISTRATION FACE SHEET.

 +10      ;---> VA/STATE SITES MAY SUBSTITUTE AN ALTERNATE CALL BELOW.

 +11           IF $$AGENCY^BWUTL5(DUZ(2))'="i"

                   Begin DoDot:2

 +12      ;---> VA/STATE SUBSTITUTE ALTERNATE PATIENT INQUIRY CODE HERE:

 +13      ;D ^VA_ROUTINE SUCH AS EN^DGRPD, AND QUIT.

 +14      ;EXAMPLE: D EN^DGRPD Q

 +15                   WRITE !!?8,"* Because this is not an Indian Health Service site,"

 +16                   WRITE !?10,"the program cannot display an IHS Face Sheet."

 +17                   WRITE !?10,"Contact your technical support people to modify"

 +18                   WRITE !?10,"line FACE+13 of the routine BWFACE."

                   End DoDot:2

                   QUIT 

 +19      ;

 +20           SET DFN=BWDFN

               DO START^AGFACE

           End DoDot:1

 +21       IF BWCRT

               DO DIRZ^BWUTL3

               WRITE @IOF

 +22       DO ^%ZISC

 +23       QUIT 

 +24      ;

FOLLUP(BWDFN) ;EP

 +1       ;---> CALLED BY PROCEDURE FOLLOW-UP MENU (BWPROC1).

 +2        NEW (BWDFN,DT,DTIME,DUZ,IO,U)

           DO SETVARS^BWUTL5

 +3        DO RUN1

 +4        QUIT 

 +5       ;

DEQUEUE   ;EP

 +1       ;---> EP FOR TASKMAN QUEUE OF PRINTOUT.

 +2        DO SETVARS^BWUTL5

           DO FACE^BWFACE

           DO EXIT

 +3        QUIT