- DPTDSX ; IHS/TUCSON/JCM - COMPARES THE SEX OF TWO PATIENTS ;
- ;;1.0;PATIENT MERGE;;FEB 02, 1994
- START ;
- D INIT
- D COMPARE
- END D EOJ
- Q
- ;
- INIT ;
- D EOJ
- S DPTDSX=$G(XDRCD(XDRFL,XDRCD,.02,"I")),DPTDSX2=$G(XDRCD2(XDRFL,XDRCD2,.02,"I"))
- S DPTDSX("MATCH")=$P(XDRDTEST(XDRDTO),U,6)
- S DPTDSX("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)
- Q
- ;
- COMPARE ;
- I DPTDSX']""!(DPTDSX2']"") G COMPAREX
- I DPTDSX=DPTDSX2 S XDRD("TEST SCORE")=DPTDSX("MATCH") G COMPAREX
- S XDRD("TEST SCORE")=DPTDSX("NO MATCH")
- COMPAREX Q
- ;
- EOJ ;
- K DPTDSX,DPTDSX2
- Q
- DPTDSX ; IHS/TUCSON/JCM - COMPARES THE SEX OF TWO PATIENTS ;
- +1 ;;1.0;PATIENT MERGE;;FEB 02, 1994
- START ;
- +1 DO INIT
- +2 DO COMPARE
- END DO EOJ
- +1 QUIT
- +2 ;
- INIT ;
- +1 DO EOJ
- +2 SET DPTDSX=$GET(XDRCD(XDRFL,XDRCD,.02,"I"))
- SET DPTDSX2=$GET(XDRCD2(XDRFL,XDRCD2,.02,"I"))
- +3 SET DPTDSX("MATCH")=$PIECE(XDRDTEST(XDRDTO),U,6)
- +4 SET DPTDSX("NO MATCH")=$PIECE(XDRDTEST(XDRDTO),U,7)
- +5 QUIT
- +6 ;
- COMPARE ;
- +1 IF DPTDSX']""!(DPTDSX2']"")
- GOTO COMPAREX
- +2 IF DPTDSX=DPTDSX2
- SET XDRD("TEST SCORE")=DPTDSX("MATCH")
- GOTO COMPAREX
- +3 SET XDRD("TEST SCORE")=DPTDSX("NO MATCH")
- COMPAREX QUIT
- +1 ;
- EOJ ;
- +1 KILL DPTDSX,DPTDSX2
- +2 QUIT