BWCDC.m

BWCDC ;IHS/ANMC/MWR - INITIAL LOAD OF CDC IDS & FLAGS;15-Feb-2003 21:49;PLS

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

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

 ;;  FOR FIRST TIME INSTALL OF V 2.0 AT SITES THAT WILL EXPORT TO CDC.

 ;;  ASSIGNS UNIQUE PATIENT IDS, FLAGS ALL PAST APPROPRIATE PROCEDURES.

 ;

FLAGEXP ;EP

 D SETVARS^BWUTL5

 ;---> FLAG ALL APPROPRIATE PROCEDURES FOR CDC EXPORT.

 W !!,"Flagging all appropriate past procedures for CDC export.",!

 ;---> *********************************

 ;---> REMOVE THESE LINES AFTER ANMC.

 ;K ^BWPCD("ACDC")

 ;---> *********************************

 S (BWCOUNT,N)=0

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

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

 .D:$$CDCEXP^BWUTL5(BWIEN,DUZ(2))

 ..W "."

 ..;---> *********************************

 ..;---> UNCOMMENT NEXT QUIT 2 LINES BELOW?

 ..;---> *********************************

 ..;---> QUIT IF IT HAS ALREADY BEEN EXPORTED OR ALREADY FLAGGED.

 ..;Q:$P(Y,U,16)]""  Q:$P(Y,U,17)]""

 ..S DR=".17////1"

 ..D DIE^BWFMAN(9002086.1,DR,N,.BWPOP,1) S:'BWPOP BWCOUNT=BWCOUNT+1

 ;

 W !,BWCOUNT," procedures flagged for CDC export."

 W !,"Done.",!

 D KILLALL^BWUTL8

BWCDC     ;IHS/ANMC/MWR - INITIAL LOAD OF CDC IDS & FLAGS;15-Feb-2003 21:49;PLS

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

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

 +3       ;;  FOR FIRST TIME INSTALL OF V 2.0 AT SITES THAT WILL EXPORT TO CDC.

 +4       ;;  ASSIGNS UNIQUE PATIENT IDS, FLAGS ALL PAST APPROPRIATE PROCEDURES.

 +5       ;

FLAGEXP   ;EP

 +1        DO SETVARS^BWUTL5

 +2       ;---> FLAG ALL APPROPRIATE PROCEDURES FOR CDC EXPORT.

 +3        WRITE !!,"Flagging all appropriate past procedures for CDC export.",!

 +4       ;---> *********************************

 +5       ;---> REMOVE THESE LINES AFTER ANMC.

 +6       ;K ^BWPCD("ACDC")

 +7       ;---> *********************************

 +8        SET (BWCOUNT,N)=0

 +9        FOR 

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

               IF 'N

                   QUIT 

               Begin DoDot:1

 +10               SET Y=^BWPCD(N,0)

                   SET BWIEN=$PIECE(Y,U,4)

 +11               IF $$CDCEXP^BWUTL5(BWIEN,DUZ(2))

                       Begin DoDot:2

 +12                       WRITE "."

 +13      ;---> *********************************

 +14      ;---> UNCOMMENT NEXT QUIT 2 LINES BELOW?

 +15      ;---> *********************************

 +16      ;---> QUIT IF IT HAS ALREADY BEEN EXPORTED OR ALREADY FLAGGED.

 +17      ;Q:$P(Y,U,16)]""  Q:$P(Y,U,17)]""

 +18                       SET DR=".17////1"

 +19                       DO DIE^BWFMAN(9002086.1,DR,N,.BWPOP,1)

                           IF 'BWPOP

                               SET BWCOUNT=BWCOUNT+1

                       End DoDot:2

               End DoDot:1

 +20      ;

 +21       WRITE !,BWCOUNT," procedures flagged for CDC export."

 +22       WRITE !,"Done.",!

 +23       DO KILLALL^BWUTL8