BRAPREG.m

BRAPREG ;IHS/BJI/DAY - Stuff Pregnance Status ; 13 Sep 2011  8:32 AM

 ;;5.0;Radiology/Nuclear Medicine;**1003**;Nov 01, 2010;Build 3

 ;

 ;

 ;Loop Rad/Nuc Med Patient File to stuff Pregnancy Status (Field 32)

 ;

 S BRADFN=0

 F  S BRADFN=$O(^RADPT(BRADFN)) Q:'BRADFN  D

 .;

 .I $P($G(^DPT(BRADFN,0)),U,2)'="F" Q

 .I $$AGE^AUPNPAT(BRADFN)<12 Q

 .I $$AGE^AUPNPAT(BRADFN)>55 Q

 .;

 .S BRADTI=""

 .F  S BRADTI=$O(^RADPT(BRADFN,"DT",BRADTI)) Q:BRADTI=""  D

 ..;

 ..S BRACNI=0

 ..F  S BRACNI=$O(^RADPT(BRADFN,"DT",BRADTI,"P",BRACNI)) Q:'BRACNI  D

 ...;

 ...S BRAZERO=$G(^RADPT(BRADFN,"DT",BRADTI,"P",BRACNI,0))

 ...;

 ...;Check Examination Status

 ...S X=$P(BRAZERO,U,3)

 ...S Y=$$GET1^DIQ(72,X,.01)

 ...;

 ...;Don't exclude COMPLETE because users can unverify reports later

 ...;I Y="COMPLETE" Q

 ...I Y="CANCELLED" Q

 ...;

 ...S $P(^RADPT(BRADFN,"DT",BRADTI,"P",BRACNI,0),U,32)="u"

 ;

 K BRADFN,BRADTI,BRACNI,BRAZERO

 Q

 ;

BRAPREG   ;IHS/BJI/DAY - Stuff Pregnance Status ; 13 Sep 2011  8:32 AM

 +1       ;;5.0;Radiology/Nuclear Medicine;**1003**;Nov 01, 2010;Build 3

 +2       ;

 +3       ;

 +4       ;Loop Rad/Nuc Med Patient File to stuff Pregnancy Status (Field 32)

 +5       ;

 +6        SET BRADFN=0

 +7        FOR 

               SET BRADFN=$ORDER(^RADPT(BRADFN))

               IF 'BRADFN

                   QUIT 

               Begin DoDot:1

 +8       ;

 +9                IF $PIECE($GET(^DPT(BRADFN,0)),U,2)'="F"

                       QUIT 

 +10               IF $$AGE^AUPNPAT(BRADFN)<12

                       QUIT 

 +11               IF $$AGE^AUPNPAT(BRADFN)>55

                       QUIT 

 +12      ;

 +13               SET BRADTI=""

 +14               FOR 

                       SET BRADTI=$ORDER(^RADPT(BRADFN,"DT",BRADTI))

                       IF BRADTI=""

                           QUIT 

                       Begin DoDot:2

 +15      ;

 +16                       SET BRACNI=0

 +17                       FOR 

                               SET BRACNI=$ORDER(^RADPT(BRADFN,"DT",BRADTI,"P",BRACNI))

                               IF 'BRACNI

                                   QUIT 

                               Begin DoDot:3

 +18      ;

 +19                               SET BRAZERO=$GET(^RADPT(BRADFN,"DT",BRADTI,"P",BRACNI,0))

 +20      ;

 +21      ;Check Examination Status

 +22                               SET X=$PIECE(BRAZERO,U,3)

 +23                               SET Y=$$GET1^DIQ(72,X,.01)

 +24      ;

 +25      ;Don't exclude COMPLETE because users can unverify reports later

 +26      ;I Y="COMPLETE" Q

 +27                               IF Y="CANCELLED"

                                       QUIT 

 +28      ;

 +29                               SET $PIECE(^RADPT(BRADFN,"DT",BRADTI,"P",BRACNI,0),U,32)="u"

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +30      ;

 +31       KILL BRADFN,BRADTI,BRACNI,BRAZERO

 +32       QUIT 

 +33      ;