XDRPTSX.m

XDRPTSX ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES THE SEX OF TWO PATIENTS; ;8/28/96  09:26

 ;;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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XDRPTSX   571     printed  Apr 09, 2024@21:42:18                                                                                                                                                                                                      Page 2

XDRPTSX   ;SF-IRMFO/IHS/OHPRD/JCM;COMPARES THE SEX OF TWO PATIENTS; ;8/28/96  09:26

 +1       ;;7.3;TOOLKIT;**23**;Apr 25, 1995

 +2       ;;

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