[613] | 1 | WVFACE ;HCIOFO/JR,FT IHS/ANMC/MWR - PRINT A FACE SHEET (FROM REG.); ;8/10/98 15:40
|
---|
| 2 | ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
---|
| 3 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
---|
| 4 | ;; DISPLAY/PRINT A FACE SHEET.
|
---|
| 5 | ;
|
---|
| 6 | D SETVARS^WVUTL5 S WVPOP1=0
|
---|
| 7 | F D RUN Q:WVPOP1
|
---|
| 8 | D EXIT
|
---|
| 9 | Q
|
---|
| 10 | ;
|
---|
| 11 | RUN ;EP
|
---|
| 12 | D TITLE^WVUTL5("DISPLAY/PRINT A PATIENT FACE SHEET")
|
---|
| 13 | D PATIENT I Y<0 S WVPOP1=1 Q
|
---|
| 14 | ;
|
---|
| 15 | RUN1 ;EP
|
---|
| 16 | ;---> PATIENT ALREADY SELECTED.
|
---|
| 17 | D DEVICE Q:WVPOP
|
---|
| 18 | D FACE
|
---|
| 19 | Q
|
---|
| 20 | ;
|
---|
| 21 | EXIT ;EP
|
---|
| 22 | D KILLALL^WVUTL8
|
---|
| 23 | Q
|
---|
| 24 | ;
|
---|
| 25 | ;
|
---|
| 26 | PATIENT ;EP
|
---|
| 27 | ;---> SELECT PATIENT (RETURN WVDFN).
|
---|
| 28 | W !!," Select the patient whose Face Sheet you wish to display."
|
---|
| 29 | D PATLKUP^WVUTL8(.Y)
|
---|
| 30 | Q:Y<0 S WVDFN=+Y
|
---|
| 31 | Q
|
---|
| 32 | ;
|
---|
| 33 | ;
|
---|
| 34 | DEVICE ;EP
|
---|
| 35 | ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
|
---|
| 36 | S ZTRTN="DEQUEUE^WVFACE",ZTSAVE("WVDFN")=""
|
---|
| 37 | D ZIS^WVUTL2(.WVPOP,1)
|
---|
| 38 | Q
|
---|
| 39 | ;
|
---|
| 40 | ;
|
---|
| 41 | FACE ;EP
|
---|
| 42 | ;---> DISPLAY CODE FOR FACE SHEET.
|
---|
| 43 | U IO
|
---|
| 44 | S WVCRT=$S($E(IOST)="C":1,1:0)
|
---|
| 45 | I WVCRT N IOF S IOF="!"
|
---|
| 46 | D
|
---|
| 47 | .I '$D(WVDFN) W !?5,"A Patient has not been selected.",! Q
|
---|
| 48 | .S DFN=WVDFN
|
---|
| 49 | .;
|
---|
| 50 | .;---> VA/STATE SITES MAY SUBSTITUTE AN ALTERNATE CALL BELOW.
|
---|
| 51 | .;D ^VA_ROUTINE SUCH AS EN^DGRPD, AND QUIT.
|
---|
| 52 | .;EXAMPLE: D EN^DGRPD Q
|
---|
| 53 | .D EN^DGRPD Q
|
---|
| 54 | .Q
|
---|
| 55 | I WVCRT&('$D(IO("S"))) D:'$G(DGRPOUT) DIRZ^WVUTL3 W @IOF
|
---|
| 56 | D ^%ZISC
|
---|
| 57 | Q
|
---|
| 58 | ;
|
---|
| 59 | FOLLUP(WVDFN) ;EP
|
---|
| 60 | ;---> CALLED BY PROCEDURE FOLLOW-UP MENU (WVPROC1).
|
---|
| 61 | D SETVARS^WVUTL5
|
---|
| 62 | D RUN1
|
---|
| 63 | Q
|
---|
| 64 | ;
|
---|
| 65 | DEQUEUE ;EP
|
---|
| 66 | ;---> EP FOR TASKMAN QUEUE OF PRINTOUT.
|
---|
| 67 | D SETVARS^WVUTL5,FACE^WVFACE,EXIT
|
---|
| 68 | Q
|
---|