- 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