MCARORF1 ; GENERATED FROM 'MCRHPHYS' PRINT TEMPLATE (#3739) ; 11/29/04 ; (continued)
G BEGIN
N W !
T W:$X ! I '$D(DIOT(2)),DN,$D(IOSL),$S('$D(DIWF):1,$P(DIWF,"B",2):$P(DIWF,"B",2),1:1)+$Y'<IOSL,$D(^UTILITY($J,1))#2,^(1)?1U1P1E.E X ^(1)
S DISTP=DISTP+1,DILCT=DILCT+1 D:'(DISTP#100) CSTP^DIO2
Q
DT I $G(DUZ("LANG"))>1,Y W $$OUT^DIALOGU(Y,"DD") Q
I Y W $P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$E(Y,4,5))_" " W:Y#100 $J(Y#100\1,2)_"," W Y\10000+1700 W:Y#1 " "_$E(Y_0,9,10)_":"_$E(Y_"000",11,12) Q
W Y Q
M D @DIXX
Q
BEGIN ;
S:'$D(DN) DN=1 S DISTP=$G(DISTP),DILCT=$G(DILCT)
D N:$X>0 Q:'DN W ?0 W "PATIENT PHYSICAL EXAMINATION"
S I(100)="^MCAR(690,",J(100)=690 S I(0,0)=D0 S DIP(1)=$S($D(^MCAR(701,D0,0)):^(0),1:"") S X=$P(DIP(1),U,2),X=X S D(0)=+X S D0=D(0) I D0>0 D C1
G C1R
C1 ;
Q
C1R ;
K J(100),I(100) S:$D(I(0,0)) D0=I(0,0)
D T Q:'DN D N D N:$X>0 Q:'DN W ?0 W "R H E U M A T I C :"
D N:$X>0 Q:'DN W ?0 W "Sysmmetrical Arthritis"
S X=$G(^MCAR(701,D0,5)) D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,1) W:Y]"" $J($S($D(DXS(41,Y)):DXS(41,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 W "Dactylitis"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,2) W:Y]"" $J($S($D(DXS(42,Y)):DXS(42,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 W "Tophi"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,3) W:Y]"" $J($S($D(DXS(43,Y)):DXS(43,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 W "Sub-Cutaneous Nodules"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,4) W:Y]"" $J($S($D(DXS(44,Y)):DXS(44,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 W "Synovial (Baker's) Cyst"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,5) W:Y]"" $J($S($D(DXS(45,Y)):DXS(45,Y),1:Y),8)
D T Q:'DN D N D N:$X>0 Q:'DN W ?0 W "Heel Pain"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,6) W:Y]"" $J($S($D(DXS(46,Y)):DXS(46,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 W "Tenosynovitis (Tendon Rubs)"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,7) W:Y]"" $J($S($D(DXS(47,Y)):DXS(47,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 W "Temporal Artery Tenderness"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,8) W:Y]"" $J($S($D(DXS(48,Y)):DXS(48,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 W "Costochondritis"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,9) W:Y]"" $J($S($D(DXS(49,Y)):DXS(49,Y),1:Y),8)
D T Q:'DN D N D N:$X>0 Q:'DN W ?0 W "F U N C T I O N A L A S S E S S M E N T :"
D N:$X>0 Q:'DN W ?0 W "Grip Strength - left"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,10) W:Y]"" $J(Y,8,0)
D N:$X>40 Q:'DN W ?40 W " mmHg"
D N:$X>0 Q:'DN W ?0 W "Grip Strength - Right"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,11) W:Y]"" $J(Y,8,0)
D N:$X>40 Q:'DN W ?40 W " mmHg"
D N:$X>0 Q:'DN W ?0 W "Schober Test (10 cm Base)"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,12) W:Y]"" $J(Y,8,0)
D N:$X>40 Q:'DN W ?40 W " cm"
D N:$X>0 Q:'DN W ?0 W "Chest Expansion"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,13) W:Y]"" $J(Y,8,0)
D N:$X>40 Q:'DN W ?40 W " cm"
D N:$X>0 Q:'DN W ?0 W "Occiput - Wall"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,14) W:Y]"" $J(Y,8,0)
D N:$X>40 Q:'DN W ?40 W " cm"
D N:$X>0 Q:'DN W ?0 W "Finger-to-Palm Crease - left"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,15) W:Y]"" $J(Y,8,1)
D N:$X>40 Q:'DN W ?40 W " cm"
D N:$X>0 Q:'DN W ?0 W "Finger-to-Palm Crease - Right"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,16) W:Y]"" $J(Y,8,1)
D N:$X>40 Q:'DN W ?40 W " cm"
D N:$X>0 Q:'DN W ?0 W "Interincisor Distance"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,17) W:Y]"" $J(Y,8,0)
D N:$X>40 Q:'DN W ?40 W " mm"
D N:$X>0 Q:'DN W ?0 W "Schirmer Test"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,18) W:Y]"" $J(Y,8,0)
D N:$X>40 Q:'DN W ?40 W " mm"
D N:$X>0 Q:'DN W ?0 W "Walk Time (50 feet)"
D N:$X>32 Q:'DN W ?32 S Y=$P(X,U,19) W:Y]"" $J(Y,8,0)
D N:$X>40 Q:'DN W ?40 W " secs"
D T Q:'DN D N D N:$X>0 Q:'DN W ?0 W "M I S C E L L A N E O U S :"
D N:$X>0 Q:'DN W ?0 W "Functional Class (ARA)"
D N:$X>63 Q:'DN W ?63 S Y=$P(X,U,20) W:Y]"" $J($S($D(DXS(50,Y)):DXS(50,Y),1:Y),16)
D N:$X>0 Q:'DN W ?0 W "Disease Severity - Patient Estimate"
D N:$X>63 Q:'DN W ?63 S Y=$P(X,U,21) W:Y]"" $J($S($D(DXS(51,Y)):DXS(51,Y),1:Y),16)
D N:$X>0 Q:'DN W ?0 W "Disease Severity - Physician Estimate"
D N:$X>63 Q:'DN W ?63 S Y=$P(X,U,52) W:Y]"" $J($S($D(DXS(52,Y)):DXS(52,Y),1:Y),16)
D T Q:'DN D N D N:$X>0 Q:'DN W ?0 W "J O I N T E X A M I N A T I O N:"
D N:$X>0 Q:'DN W ?0 W "LEFT"
D N:$X>70 Q:'DN W ?70 W "RIGHT"
D N:$X>0 Q:'DN W ?0 W "----"
D N:$X>70 Q:'DN W ?70 W "-----"
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,22) W:Y]"" $S($D(DXS(53,Y)):DXS(53,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "Fingers - DIPs"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,23) W:Y]"" $J($S($D(DXS(54,Y)):DXS(54,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,24) W:Y]"" $S($D(DXS(55,Y)):DXS(55,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "Fingers - PIPs"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,25) W:Y]"" $J($S($D(DXS(56,Y)):DXS(56,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,26) W:Y]"" $S($D(DXS(57,Y)):DXS(57,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "MCPs"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,27) W:Y]"" $J($S($D(DXS(58,Y)):DXS(58,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,28) W:Y]"" $S($D(DXS(59,Y)):DXS(59,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "First Carpomentacarpal"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,29) W:Y]"" $J($S($D(DXS(60,Y)):DXS(60,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,30) W:Y]"" $S($D(DXS(61,Y)):DXS(61,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "Wrist"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,31) W:Y]"" $J($S($D(DXS(62,Y)):DXS(62,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,32) W:Y]"" $S($D(DXS(63,Y)):DXS(63,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "Elbow"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,33) W:Y]"" $J($S($D(DXS(64,Y)):DXS(64,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,34) W:Y]"" $S($D(DXS(65,Y)):DXS(65,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "Shoulder"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,35) W:Y]"" $J($S($D(DXS(66,Y)):DXS(66,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,36) W:Y]"" $S($D(DXS(67,Y)):DXS(67,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "Sternoclavicular"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,37) W:Y]"" $J($S($D(DXS(68,Y)):DXS(68,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,38) W:Y]"" $S($D(DXS(69,Y)):DXS(69,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "TMJ"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,39) W:Y]"" $J($S($D(DXS(70,Y)):DXS(70,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,40) W:Y]"" $S($D(DXS(71,Y)):DXS(71,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "HIP"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,41) W:Y]"" $J($S($D(DXS(72,Y)):DXS(72,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,42) W:Y]"" $S($D(DXS(73,Y)):DXS(73,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "Knee"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,43) W:Y]"" $J($S($D(DXS(74,Y)):DXS(74,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,44) W:Y]"" $S($D(DXS(75,Y)):DXS(75,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "Ankle"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,45) W:Y]"" $J($S($D(DXS(76,Y)):DXS(76,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,46) W:Y]"" $S($D(DXS(77,Y)):DXS(77,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "MTP"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,47) W:Y]"" $J($S($D(DXS(78,Y)):DXS(78,Y),1:Y),8)
D N:$X>0 Q:'DN W ?0 S Y=$P(X,U,48) W:Y]"" $S($D(DXS(79,Y)):DXS(79,Y),1:Y)
D N:$X>30 Q:'DN W ?30 W "Toes - PIP"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,49) W:Y]"" $J($S($D(DXS(80,Y)):DXS(80,Y),1:Y),8)
D T Q:'DN D N D N:$X>30 Q:'DN W ?30 W "Cervical Spine"
D N:$X>70 Q:'DN W ?70 S Y=$P(X,U,50) W:Y]"" $J($S($D(DXS(81,Y)):DXS(81,Y),1:Y),8)
D N:$X>30 Q:'DN W ?30 W "Lumber Spine"
G ^MCARORF2
MCARORF1 ; GENERATED FROM 'MCRHPHYS' PRINT TEMPLATE (#3739) ; 11/29/04 ; (continued)
+1 GOTO BEGIN
N WRITE !
T IF $X
WRITE !
IF '$DATA(DIOT(2))
IF DN
IF $DATA(IOSL)
IF $SELECT('$DATA(DIWF):1,$PIECE(DIWF,"B",2):$PIECE(DIWF,"B",2),1:1)+$Y'<IOSL
IF $DATA(^UTILITY($JOB,1))#2
IF ^(1)?1U1P1E.E
XECUTE ^(1)
+1 SET DISTP=DISTP+1
SET DILCT=DILCT+1
IF '(DISTP#100)
DO CSTP^DIO2
+2 QUIT
DT IF $GET(DUZ("LANG"))>1
IF Y
WRITE $$OUT^DIALOGU(Y,"DD")
QUIT
+1 IF Y
WRITE $PIECE("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$EXTRACT(Y,4,5))_" "
IF Y#100
WRITE $JUSTIFY(Y#100\1,2)_","
WRITE Y\10000+1700
IF Y#1
WRITE " "_$EXTRACT(Y_0,9,10)_":"_$EXTRACT(Y_"000",11,12)
QUIT
+2 WRITE Y
QUIT
M DO @DIXX
+1 QUIT
BEGIN ;
+1 IF '$DATA(DN)
SET DN=1
SET DISTP=$GET(DISTP)
SET DILCT=$GET(DILCT)
+2 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "PATIENT PHYSICAL EXAMINATION"
+3 SET I(100)="^MCAR(690,"
SET J(100)=690
SET I(0,0)=D0
SET DIP(1)=$SELECT($DATA(^MCAR(701,D0,0)):^(0),1:"")
SET X=$PIECE(DIP(1),U,2)
SET X=X
SET D(0)=+X
SET D0=D(0)
IF D0>0
DO C1
+4 GOTO C1R
C1 ;
+1 QUIT
C1R ;
+1 KILL J(100),I(100)
IF $DATA(I(0,0))
SET D0=I(0,0)
+2 DO T
IF 'DN
QUIT
DO N
IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "R H E U M A T I C :"
+3 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Sysmmetrical Arthritis"
+4 SET X=$GET(^MCAR(701,D0,5))
IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,1)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(41,Y)):DXS(41,Y),1:Y),8)
+5 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Dactylitis"
+6 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,2)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(42,Y)):DXS(42,Y),1:Y),8)
+7 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Tophi"
+8 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,3)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(43,Y)):DXS(43,Y),1:Y),8)
+9 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Sub-Cutaneous Nodules"
+10 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,4)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(44,Y)):DXS(44,Y),1:Y),8)
+11 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Synovial (Baker's) Cyst"
+12 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,5)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(45,Y)):DXS(45,Y),1:Y),8)
+13 DO T
IF 'DN
QUIT
DO N
IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Heel Pain"
+14 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,6)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(46,Y)):DXS(46,Y),1:Y),8)
+15 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Tenosynovitis (Tendon Rubs)"
+16 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,7)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(47,Y)):DXS(47,Y),1:Y),8)
+17 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Temporal Artery Tenderness"
+18 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,8)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(48,Y)):DXS(48,Y),1:Y),8)
+19 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Costochondritis"
+20 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,9)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(49,Y)):DXS(49,Y),1:Y),8)
+21 DO T
IF 'DN
QUIT
DO N
IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "F U N C T I O N A L A S S E S S M E N T :"
+22 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Grip Strength - left"
+23 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,10)
IF Y]""
WRITE $JUSTIFY(Y,8,0)
+24 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE " mmHg"
+25 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Grip Strength - Right"
+26 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,11)
IF Y]""
WRITE $JUSTIFY(Y,8,0)
+27 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE " mmHg"
+28 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Schober Test (10 cm Base)"
+29 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,12)
IF Y]""
WRITE $JUSTIFY(Y,8,0)
+30 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE " cm"
+31 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Chest Expansion"
+32 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,13)
IF Y]""
WRITE $JUSTIFY(Y,8,0)
+33 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE " cm"
+34 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Occiput - Wall"
+35 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,14)
IF Y]""
WRITE $JUSTIFY(Y,8,0)
+36 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE " cm"
+37 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Finger-to-Palm Crease - left"
+38 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,15)
IF Y]""
WRITE $JUSTIFY(Y,8,1)
+39 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE " cm"
+40 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Finger-to-Palm Crease - Right"
+41 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,16)
IF Y]""
WRITE $JUSTIFY(Y,8,1)
+42 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE " cm"
+43 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Interincisor Distance"
+44 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,17)
IF Y]""
WRITE $JUSTIFY(Y,8,0)
+45 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE " mm"
+46 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Schirmer Test"
+47 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,18)
IF Y]""
WRITE $JUSTIFY(Y,8,0)
+48 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE " mm"
+49 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Walk Time (50 feet)"
+50 IF $X>32
DO N
IF 'DN
QUIT
WRITE ?32
SET Y=$PIECE(X,U,19)
IF Y]""
WRITE $JUSTIFY(Y,8,0)
+51 IF $X>40
DO N
IF 'DN
QUIT
WRITE ?40
WRITE " secs"
+52 DO T
IF 'DN
QUIT
DO N
IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "M I S C E L L A N E O U S :"
+53 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Functional Class (ARA)"
+54 IF $X>63
DO N
IF 'DN
QUIT
WRITE ?63
SET Y=$PIECE(X,U,20)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(50,Y)):DXS(50,Y),1:Y),16)
+55 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Disease Severity - Patient Estimate"
+56 IF $X>63
DO N
IF 'DN
QUIT
WRITE ?63
SET Y=$PIECE(X,U,21)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(51,Y)):DXS(51,Y),1:Y),16)
+57 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "Disease Severity - Physician Estimate"
+58 IF $X>63
DO N
IF 'DN
QUIT
WRITE ?63
SET Y=$PIECE(X,U,52)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(52,Y)):DXS(52,Y),1:Y),16)
+59 DO T
IF 'DN
QUIT
DO N
IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "J O I N T E X A M I N A T I O N:"
+60 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "LEFT"
+61 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
WRITE "RIGHT"
+62 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
WRITE "----"
+63 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
WRITE "-----"
+64 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,22)
IF Y]""
WRITE $SELECT($DATA(DXS(53,Y)):DXS(53,Y),1:Y)
+65 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "Fingers - DIPs"
+66 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,23)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(54,Y)):DXS(54,Y),1:Y),8)
+67 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,24)
IF Y]""
WRITE $SELECT($DATA(DXS(55,Y)):DXS(55,Y),1:Y)
+68 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "Fingers - PIPs"
+69 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,25)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(56,Y)):DXS(56,Y),1:Y),8)
+70 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,26)
IF Y]""
WRITE $SELECT($DATA(DXS(57,Y)):DXS(57,Y),1:Y)
+71 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "MCPs"
+72 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,27)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(58,Y)):DXS(58,Y),1:Y),8)
+73 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,28)
IF Y]""
WRITE $SELECT($DATA(DXS(59,Y)):DXS(59,Y),1:Y)
+74 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "First Carpomentacarpal"
+75 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,29)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(60,Y)):DXS(60,Y),1:Y),8)
+76 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,30)
IF Y]""
WRITE $SELECT($DATA(DXS(61,Y)):DXS(61,Y),1:Y)
+77 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "Wrist"
+78 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,31)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(62,Y)):DXS(62,Y),1:Y),8)
+79 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,32)
IF Y]""
WRITE $SELECT($DATA(DXS(63,Y)):DXS(63,Y),1:Y)
+80 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "Elbow"
+81 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,33)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(64,Y)):DXS(64,Y),1:Y),8)
+82 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,34)
IF Y]""
WRITE $SELECT($DATA(DXS(65,Y)):DXS(65,Y),1:Y)
+83 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "Shoulder"
+84 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,35)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(66,Y)):DXS(66,Y),1:Y),8)
+85 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,36)
IF Y]""
WRITE $SELECT($DATA(DXS(67,Y)):DXS(67,Y),1:Y)
+86 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "Sternoclavicular"
+87 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,37)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(68,Y)):DXS(68,Y),1:Y),8)
+88 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,38)
IF Y]""
WRITE $SELECT($DATA(DXS(69,Y)):DXS(69,Y),1:Y)
+89 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "TMJ"
+90 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,39)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(70,Y)):DXS(70,Y),1:Y),8)
+91 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,40)
IF Y]""
WRITE $SELECT($DATA(DXS(71,Y)):DXS(71,Y),1:Y)
+92 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "HIP"
+93 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,41)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(72,Y)):DXS(72,Y),1:Y),8)
+94 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,42)
IF Y]""
WRITE $SELECT($DATA(DXS(73,Y)):DXS(73,Y),1:Y)
+95 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "Knee"
+96 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,43)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(74,Y)):DXS(74,Y),1:Y),8)
+97 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,44)
IF Y]""
WRITE $SELECT($DATA(DXS(75,Y)):DXS(75,Y),1:Y)
+98 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "Ankle"
+99 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,45)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(76,Y)):DXS(76,Y),1:Y),8)
+100 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,46)
IF Y]""
WRITE $SELECT($DATA(DXS(77,Y)):DXS(77,Y),1:Y)
+101 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "MTP"
+102 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,47)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(78,Y)):DXS(78,Y),1:Y),8)
+103 IF $X>0
DO N
IF 'DN
QUIT
WRITE ?0
SET Y=$PIECE(X,U,48)
IF Y]""
WRITE $SELECT($DATA(DXS(79,Y)):DXS(79,Y),1:Y)
+104 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "Toes - PIP"
+105 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,49)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(80,Y)):DXS(80,Y),1:Y),8)
+106 DO T
IF 'DN
QUIT
DO N
IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "Cervical Spine"
+107 IF $X>70
DO N
IF 'DN
QUIT
WRITE ?70
SET Y=$PIECE(X,U,50)
IF Y]""
WRITE $JUSTIFY($SELECT($DATA(DXS(81,Y)):DXS(81,Y),1:Y),8)
+108 IF $X>30
DO N
IF 'DN
QUIT
WRITE ?30
WRITE "Lumber Spine"
+109 GOTO ^MCARORF2
