BWLOOP.m

BWLOOP ;IHS/ANMC/MWR - UTILITY HARDCODED LOOPS.;15-Feb-2003 21:57;PLS

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

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

 ;;  PROGRAMMER UTILITY LOOP FOR TECHNICAL SUPPORT OF BW PATIENT

 ;;  OR PROCEDURE FILE.  NOT CALLED BY ANY OPTION.

 ;

 D SETVARS^BWUTL5

 ;

 ;D PROC

 ;D PATIENT

 ;

EXIT ;EP

 D KILLALL^BWUTL8

 Q

 ;

 ;

PROC ;EP

 ;---> PROCEDURE LOOP.

 ;Q

 S BWIEN=0

 F  S BWIEN=$O(^BWPCD(BWIEN)) Q:'BWIEN  D

 .S PCDIEN=$P(^BWPCD(BWIEN,0),U,4)

 .S DIE="^BWPCD(",DA=BWIEN

 .S DR=".16////@;.17///"_$$CDCEXP^BWUTL5(PCDIEN,DUZ(2))

 .D ^DIE

 .W "."

 Q

 ;

PATIENT ;EP

 ;---> PATIENT LOOP.

 ;Q

 S N=0

 F  S N=$O(^BWP(N)) Q:'N  D

 .W !,$P(^BWP(N,0),U,21)

 .;S $P(^BWP(N,0),U,21)=""

 ;K ^BWP("CDC")

 Q

BWLOOP    ;IHS/ANMC/MWR - UTILITY HARDCODED LOOPS.;15-Feb-2003 21:57;PLS

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

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

 +3       ;;  PROGRAMMER UTILITY LOOP FOR TECHNICAL SUPPORT OF BW PATIENT

 +4       ;;  OR PROCEDURE FILE.  NOT CALLED BY ANY OPTION.

 +5       ;

 +6        DO SETVARS^BWUTL5

 +7       ;

 +8       ;D PROC

 +9       ;D PATIENT

 +10      ;

EXIT      ;EP

 +1        DO KILLALL^BWUTL8

 +2        QUIT 

 +3       ;

 +4       ;

PROC      ;EP

 +1       ;---> PROCEDURE LOOP.

 +2       ;Q

 +3        SET BWIEN=0

 +4        FOR 

               SET BWIEN=$ORDER(^BWPCD(BWIEN))

               IF 'BWIEN

                   QUIT 

               Begin DoDot:1

 +5                SET PCDIEN=$PIECE(^BWPCD(BWIEN,0),U,4)

 +6                SET DIE="^BWPCD("

                   SET DA=BWIEN

 +7                SET DR=".16////@;.17///"_$$CDCEXP^BWUTL5(PCDIEN,DUZ(2))

 +8                DO ^DIE

 +9                WRITE "."

               End DoDot:1

 +10       QUIT 

 +11      ;

PATIENT   ;EP

 +1       ;---> PATIENT LOOP.

 +2       ;Q

 +3        SET N=0

 +4        FOR 

               SET N=$ORDER(^BWP(N))

               IF 'N

                   QUIT 

               Begin DoDot:1

 +5                WRITE !,$PIECE(^BWP(N,0),U,21)

 +6       ;S $P(^BWP(N,0),U,21)=""

               End DoDot:1

 +7       ;K ^BWP("CDC")

 +8        QUIT