BWMPUTL.m

BWMPUTL ;IHS/CIA/PLS - Mammography Project Utility Calls ;03-Sep-2003 20:12;PLS

 ;;2.0;WOMEN'S PACKAGE;**9**;;10-Apr-2003 10:03

 ;=================================================================

 ;

MPPRVEXM(EXMIEN) ;

 Q $$PREVEXM(44,BWDFN,EXMIEN)

 ; Return exam previous to given exam ien

PREVEXM(PROCTYP,DFN,EXMIEN) ;

 N X,RES

 S RES=""

 S PROCTYP=$G(PROCTYP,0)

 S DFN=+$G(DFN,0)

 S EXMIEN=+$G(EXMIEN,0)

 Q:'PROCTYP!('DFN)!('EXMIEN) RES

 S X=EXMIEN

 F  S X=$O(^BWPCD("C",DFN,X),-1) Q:X<1  D

 .Q:$P(^BWPCD(X,0),U,4)'=PROCTYP

 .S RES=$$FMTE^XLFDT($$GET1^DIQ(9002086.1,X,.12,"I"),"5Z")

 Q RES

 ; Result Flag for Blood Relatives with Breast Cancer

 ; Input: Procedure IEN

 ; Output: 0 - No relatives with BC; 1=Relatives with BC

BRELBC(PROC) ;

 N RES,RELM,RELS,RELD

 S RELM=$$GET^DDSVAL(DIE,.DA,10.07)  ;$$GET1^DIQ(9002086.1,PROC,10.07,"I")

 S RELS=$$GET^DDSVAL(DIE,.DA,10.08)  ;$$GET1^DIQ(9002086.1,PROC,10.08,"I")

 S RELD=$$GET^DDSVAL(DIE,.DA,10.09)   ;$$GET1^DIQ(9002086.1,PROC,10.09,"I")

 S RES=(RELM=3)!((RELS=1)!(RELS=2))!((RELD=1)!(RELD=2))

 Q RES

BWMPUTL   ;IHS/CIA/PLS - Mammography Project Utility Calls ;03-Sep-2003 20:12;PLS

 +1       ;;2.0;WOMEN'S PACKAGE;**9**;;10-Apr-2003 10:03

 +2       ;=================================================================

 +3       ;

MPPRVEXM(EXMIEN) ;

 +1        QUIT $$PREVEXM(44,BWDFN,EXMIEN)

 +2       ; Return exam previous to given exam ien

PREVEXM(PROCTYP,DFN,EXMIEN) ;

 +1        NEW X,RES

 +2        SET RES=""

 +3        SET PROCTYP=$GET(PROCTYP,0)

 +4        SET DFN=+$GET(DFN,0)

 +5        SET EXMIEN=+$GET(EXMIEN,0)

 +6        IF 'PROCTYP!('DFN)!('EXMIEN)

               QUIT RES

 +7        SET X=EXMIEN

 +8        FOR 

               SET X=$ORDER(^BWPCD("C",DFN,X),-1)

               IF X<1

                   QUIT 

               Begin DoDot:1

 +9                IF $PIECE(^BWPCD(X,0),U,4)'=PROCTYP

                       QUIT 

 +10               SET RES=$$FMTE^XLFDT($$GET1^DIQ(9002086.1,X,.12,"I"),"5Z")

               End DoDot:1

 +11       QUIT RES

 +12      ; Result Flag for Blood Relatives with Breast Cancer

 +13      ; Input: Procedure IEN

 +14      ; Output: 0 - No relatives with BC; 1=Relatives with BC

BRELBC(PROC) ;

 +1        NEW RES,RELM,RELS,RELD

 +2       ;$$GET1^DIQ(9002086.1,PROC,10.07,"I")

           SET RELM=$$GET^DDSVAL(DIE,.DA,10.07)

 +3       ;$$GET1^DIQ(9002086.1,PROC,10.08,"I")

           SET RELS=$$GET^DDSVAL(DIE,.DA,10.08)

 +4       ;$$GET1^DIQ(9002086.1,PROC,10.09,"I")

           SET RELD=$$GET^DDSVAL(DIE,.DA,10.09)

 +5        SET RES=(RELM=3)!((RELS=1)!(RELS=2))!((RELD=1)!(RELD=2))

 +6        QUIT RES