- 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
