- XDRPTSX ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES THE SEX OF TWO PATIENTS; ;8/28/96 09:26 [ 04/02/2003 8:47 AM ]
- ;;7.3;TOOLKIT;**1001**;APR 1, 2003
- ;;7.3;TOOLKIT;**23**;Apr 25, 1995
- ;;
- START ;
- D INIT
- D COMPARE
- END D EOJ
- Q
- ;
- INIT ;
- D EOJ
- S XDRDSX=XDRCD(XDRFL,XDRCD,.02,"I"),XDRDSX2=XDRCD2(XDRFL,XDRCD2,.02,"I")
- S XDRDSX("MATCH")=$P(XDRDTEST(XDRDTO),U,6)
- S XDRDSX("NO MATCH")=$P(XDRDTEST(XDRDTO),U,7)
- Q
- ;
- COMPARE ;
- I XDRDSX']""!(XDRDSX2']"") G COMPAREX
- I XDRDSX=XDRDSX2 S XDRD("TEST SCORE")=XDRDSX("MATCH") G COMPAREX
- S XDRD("TEST SCORE")=XDRDSX("NO MATCH")
- COMPAREX Q
- ;
- EOJ ;
- K XDRDSX,XDRDSX2
- Q
- XDRPTSX ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES THE SEX OF TWO PATIENTS; ;8/28/96 09:26 [ 04/02/2003 8:47 AM ]
- +1 ;;7.3;TOOLKIT;**1001**;APR 1, 2003
- +2 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
- +3 ;;
- START ;
- +1 DO INIT
- +2 DO COMPARE
- END DO EOJ
- +1 QUIT
- +2 ;
- INIT ;
- +1 DO EOJ
- +2 SET XDRDSX=XDRCD(XDRFL,XDRCD,.02,"I")
- SET XDRDSX2=XDRCD2(XDRFL,XDRCD2,.02,"I")
- +3 SET XDRDSX("MATCH")=$PIECE(XDRDTEST(XDRDTO),U,6)
- +4 SET XDRDSX("NO MATCH")=$PIECE(XDRDTEST(XDRDTO),U,7)
- +5 QUIT
- +6 ;
- COMPARE ;
- +1 IF XDRDSX']""!(XDRDSX2']"")
- GOTO COMPAREX
- +2 IF XDRDSX=XDRDSX2
- SET XDRD("TEST SCORE")=XDRDSX("MATCH")
- GOTO COMPAREX
- +3 SET XDRD("TEST SCORE")=XDRDSX("NO MATCH")
- COMPAREX QUIT
- +1 ;
- EOJ ;
- +1 KILL XDRDSX,XDRDSX2
- +2 QUIT