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 ---[H[J[2J[HXDRPTSX 571 printed Dec 13, 2024@02:39:48 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
